Excel VBA質問箱 IV

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

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


55713 / 76732 ←次へ | 前へ→

【25786】Re:3つのコード合致の応用
回答  Hirofumi  - 05/6/14(火) 18:44 -

引用なし
パスワード
   >>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

0 hits

【25723】3つのコード合致の応用 Lee 05/6/12(日) 0:22 質問
【25724】Re:3つのコード合致の応用 Hirofumi 05/6/12(日) 7:39 回答
【25733】Re:3つのコード合致の応用 Lee 05/6/13(月) 10:24 質問
【25755】Re:3つのコード合致の応用 Hirofumi 05/6/13(月) 18:59 回答
【25767】Re:3つのコード合致の応用 Lee 05/6/13(月) 23:47 質問
【25786】Re:3つのコード合致の応用 Hirofumi 05/6/14(火) 18:44 回答
【25787】Re:3つのコード合致の応用 Hirofumi 05/6/14(火) 18:58 回答
【25793】Re:3つのコード合致の応用 Lee 05/6/14(火) 22:15 お礼

55713 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free