Excel VBA質問箱 IV

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

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


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

14699 / 76738

←次へ　｜　前へ→


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

kanabun - 10/12/10(金) 20:33 -


	引用なし

	パスワード

▼まりなさん：
おまたせしました！

>桁数が多くてできない点

原因が分かりましたので、Sub Try2() に修正を施しました。

　　検索対象列、検索する最初の行および
　　結果を書き込む列番号を修正の上、
　　以下をお試しください。

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

0 hits

▼

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