| |
>>2、「取得したいデータの入ったSheetに重複検索をかけると、
>> 数件の重複データが出力されました。」と有りますが？
>> 重複検索とは、何を使って行いましたか？
>
>Hirofumiさんに作成していたものを使用しました。
此れも、2つのコード用に修正しましたか？
Option Explicit
Public Sub Examination2()
Dim i As Long
Dim j As Long
Dim vntData As Variant
Dim lngRows As Long
Dim lngRow As Long
Dim rngResult As Range
Dim vntResult As Variant
Dim dicIndex As Object
Dim vntKey As Variant
Dim strProm As String
Dim lngOffset As Long
'検査結果を出力するSheetを設定
Set rngResult = Worksheets("Sheet3").Cells(1, "A")
With rngResult.Resize(, 8)
.Value = Array("登録行", "Aコード", "Bコード", "Cコード", _
"重複行", "Aコード", "Bコード", "Cコード")
End With
'検査結果出力用配列を確保
ReDim vntResult(1 To 1, 1 To 8)
lngRow = 1
'Sheet2(Dコードの有るList）のList先頭セルを指定（列見出しの左上隅）
With Worksheets("Sheet2").Cells(1, "A")
'Offset量
lngOffset = .Row
'データ行数を取得
lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row
If lngRows <= 0 Then
strProm = "データが有りません"
GoTo Wayout
End If
'データを配列に取得
vntData = .Offset(1).Resize(lngRows, 3).Value
End With
'Dictionaryオブジェクトのインスタンスを取得
Set dicIndex = CreateObject("Scripting.Dictionary")
'Indexを作成
With dicIndex
'データ全てに繰り返し
For i = 1 To lngRows
'Aコード、Bコード、CコードをKeyとする
vntKey = vntData(i, 1) & vbTab _
& vntData(i, 2)
'もしKeyが重複する場合
If .Exists(vntKey) Then
vntResult(1, 1) = .Item(vntKey)
vntResult(1, 5) = i + lngOffset
For j = 1 To 3
vntResult(1, j + 1) = vntData(vntResult(1, 1), j)
vntResult(1, j + 5) = vntData(i, j)
Next j
vntResult(1, 1) = vntResult(1, 1) + lngOffset
With rngResult.Offset(lngRow).Resize(, 8)
.NumberFormatLocal = "@"
.Value = vntResult
End With
lngRow = lngRow + 1
Else
'KeyとDコードをIndexに登録
.Add vntKey, i
End If
Next i
End With
strProm = "処理が完了しました"
Wayout:
Set dicIndex = Nothing
Set rngResult = Nothing
Beep
MsgBox strProm
End Sub
|
|
Hirofumi
- 05/6/14(火) 18:44 -
