Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

14653 / 76738

←次へ　｜　前へ→


	【67574】Re:重複したデータにしるしをつける

kanabun - 10/12/14(火) 16:57 -


	引用なし

	パスワード

▼まりなさん：
こんにちは～

>度々すみません。
>ＶＢＡを機動させるボタンをSheet3にオートシェイプでセットし、
>Sheet2のデータについて、kanabunさんに教えて頂いたＶＢＡを機動させるには、
>以下のマクロに何を付け加えたらよいでしょうか？

試してないけど、
２か所、シートを指定するだけでよいと思いますよ
>>Sub Try2_Mod()
>>　Const COL1 = 2　　'検索対象列
>>　Const ROW1 = 2　　'検索する最初の行
>>　Const COL2 = 15　 '結果を書き込む列
>>　Dim i As Long, n As Long
>>　Dim v, ss As String
>>　Dim dic As Object
>>
>>　'↓検索範囲データを（文字列にして）配列にコピーする
　　With Worksheets("Sheet2").Columns(COL1).Cells
>>　　　v = Excel.Range(.Item(ROW1), _
>>　　　　　　　　　　.Item(.Count).End(xlUp)).Value2　'◆修正
>>　End With
>>
>>　'↓Dicionaryを使って重複チェック
>>　Set dic = CreateObject("Scripting.Dictionary")
>>　ReDim dup(1 To UBound(v), 0)
>>　For i = 1 To UBound(v)
>>　　　ss = CStr(v(i, 1))　　 '◆ ここで強制的に文字列にする
>>　　　If dic.Exists(ss) Then 'すでにこのキーが辞書にあれば
>>　　　　　n = dic(ss)　　　　'このキーがどの行で出現したかを得る
>>　　　　　If n > 0 Then
>>　　　　　　　dup(n, 0) = "重複"　'直前の出現行に「重複」書き込み
>>　　　　　　　dic(ss) = 0
>>　　　　　End If
>>　　　　　dup(i, 0) = "重複"　　　　　'この行に「重複」書き込み
>>　　　Else
>>　　　　　dic(ss) = i　　　'行のデータを出現行とともに辞書に入れる
>>　　　End If
>>　Next
>>　Set dic = Nothing
>>
>>　' COL2 列に結果を書き出す
　Worksheets("Sheet2").Cells(ROW1, COL2).Resize(UBound(dup)).Value = dup
>>End Sub

対象ワークシートも、変数使って
Dim WS As Worksheet
Set WS = Worksheets("Sheet2")
　:
　:
>>　'↓検索範囲データを（文字列にして）配列にコピーする
　　With WS.Columns(COL1).Cells

　:
　:
>>　' COL2 列に結果を書き出す
　WS.Cells(ROW1, COL2).Resize(UBound(dup)).Value = dup

としておくと、最初の Set WS = の右辺を替えるだけで、
再利用しやすくなりますね。

0 hits

▼

【67407】重複したデータにしるしをつける まりな 10/12/1(水) 16:59