人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

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

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

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


<変換前>

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



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

●質問者: nankichi
●カテゴリ:ビジネス・経営 コンピュータ
✍キーワード:cell Excel VBA けが エクセル
○ 状態 :終了
└ 回答数 : 5/5件

▽最新の回答へ

1 ● たけじん
●23ポイント

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 : たてのセル数

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

◎質問者からの返答

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

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

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

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

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


2 ● ちゃぼりん
●23ポイント

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

3 ● gong1971
●22ポイント

こういう時は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


4 ● Chitchi
●22ポイント

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

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


5 ● たけじん
●10ポイント

一番目の回答者です。

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

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

勉強になります。

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

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

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

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

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ