Excel VBA質問箱 IV

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

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


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

14651 / 76734

←次へ　｜　前へ→


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

まりな - 10/12/14(火) 15:11 -


	引用なし

	パスワード

▼kanabun さん：

度々すみません。
ＶＢＡを機動させるボタンを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 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 列に結果を書き出す
>　Cells(ROW1, COL2).Resize(UBound(dup)).Value = dup
>End Sub

1 hits

▼

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