【excel VBA 2003】

エクセル マクロでの質問です。下記条件を満たす、ソースコードを教えてください。

xxxという縦1列のrangeがあります。
このrangeに含まれるcellのvalueには、文字列だけが入っています。(ただしブランクがある場合もあります)

xxxの中で、上から順に文字列の重複チェックをして、重複していたら、二つめ以降に"_2"等のsuffixをつけたいと思います。


<変換前>

てすと
テスト
てすすう
テスト
てすうう
てすすう
テスト
てすとと



<変換後>
てすと
テスト
てすすう
テスト_2
てすうう
てすすう_2
テスト_3
てすとと

回答の条件
  • 1人3回まで
  • 登録:2006/05/11 18:04:29
  • 終了:2006/05/18 18:05:36

回答(5件)

id:takejin No.1

たけじん回答回数1501ベストアンサー獲得回数1962006/05/11 19:05:11

ポイント23pt

for i=1 to l_max

s_value = cells(i,1).value

s_num = 1

for l=i+1 to l_max

if s_value = cells(l,1).value then

s_num = s_num+1

add_string = "_" & str(s_num)

cells(l,1).value = s_value & add_string

end if

next l

next i

l_max : たてのセル数

このような感じでどうでしょうか

id:nankichi

ふむふむ、2回ループを回すのですね。

いろいろなやり方があるかと思うので、他の方法があれば、是非ご教授ください。

ちなみに一度add_string に入れるのはなぜでしょうか?

cells(l,1).value = cells(l,1).value & "_" & str(s_num)

でもいいかと思ったのですが、可読性とか実行スピードとか、でしょうか。

2006/05/11 20:08:58
id:Chaborin No.2

ちゃぼりん回答回数189ベストアンサー獲得回数72006/05/11 23:03:44

ポイント23pt

http://msdn.microsoft.com/library/ja/default.asp?url=/library/ja...

Dictionaryオブジェクトでやるのが楽かと思います。

テストしてないのでそのまま動くかは不明です。

'[宣言]
Dim dic as object
Dim hoge as string
Dim fuga as variant
Dim i as integer
Set dic=CreateObject("Scripting.Dictionary")
'[格納]
for i = 1 to [その列の最大行...なんだったか忘れた]
 hoge=cells(i,1).value
 If not dic.exists(hoge) Then 
  '[初回]
  dic.add hoge,1
 else
  '[2回目以降]
  fuga=dic.item(hoge)+1
  dic.remove(hoge)
  dic.add(hoge,fuga)
  cells(i,1).value=hoge&"_"&fuga
 end If
Next i
'[おかたづけ]
dic.removeall
Set dic=Nothing
id:gong1971 No.3

gong1971回答回数443ベストアンサー獲得回数682006/05/11 23:06:15

ポイント22pt

こういう時はDictionaryオブジェクトを使うと便利です。Dictionaryオブジェクトを使う前にマクロの編集画面で、

[ツール]メニューから[参照設定]の画面を開き、"Microsoft Scripting Runtime"のチェックを入れます。

上記の設定をした上で下記のコードを実行します。

Dim c As Range

Dim dct As Scripting.Dictionary

Set dct = New Scripting.Dictionary

For Each c In XXX

If c.Value <> "" Then

If dct.Exists(c.Value) Then

i = dct.Item(c.Value)

dct.Remove c.Value

dct.Add c.Value, i + 1

c.Value = c.Value & "_" & i + 1

Else

dct.Add c.Value, 1

End If

End If

Next

id:Chitchi No.4

Chitchi回答回数1ベストアンサー獲得回数02006/05/12 00:48:52

ポイント22pt

Sub Macro1()

Dim c As Range

Dim firstAddress As String, dumy As String

Dim i As Long, n As Long

' ---マクロの速度を向上させるため

' 画面を更新しないようにします

Application.ScreenUpdating = False

With ActiveSheet.Cells

For i = 1 To 100

dumy = Cells(i, 1).Value

If dumy <> "" Then

n = 0

' ---Findメソッドを使う

Set c = .Find(What:=dumy, LookIn:=xlValues, _

MatchCase:=True, MatchByte:=True)

If Not c Is Nothing Then

firstAddress = c.Address

Do

If c.Address <> firstAddress Then

n = n + 1

c.Value = dumy & "_" & Str(n)

End If

Set c = .FindNext(c)

Loop While Not c Is Nothing And _

c.Address <> firstAddress

End If

End If

Next i

End With

' ---画面を更新するように戻す

Application.ScreenUpdating = True

End Sub

こちらは、どうでしょうか

id:takejin No.5

たけじん回答回数1501ベストアンサー獲得回数1962006/05/13 02:19:59

ポイント10pt

一番目の回答者です。

add_stringの件ですが、基本的に可読性です。癖になっているので、一行には一処理にしています。(頭悪いので、すぐ理解できなくなってしまう)

色々なやりかたがあるようですね。

勉強になります。

マクロでなくて関数でやってみると、

B列に、COUNTIF(A$1:A10,A10)(10行目の場合)

C列に、IF(B10>1,A10&"_"&B10,A10)(これも10行目)

と書けば、C列に変換後の文字が並びます。

コメントはまだありません

この質問への反応(ブックマークコメント)

トラックバック

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません