Excel VBA質問箱 IV

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

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


55776 / 76732 ←次へ | 前へ→

【25723】3つのコード合致の応用
質問  Lee  - 05/6/12(日) 0:22 -

引用なし
パスワード
   Hirofumiさん

こんばんは。
昨日の続きで
コードを2つに減らして試してみましたが、
上手くいきません。。。
どこがおかしいのでしょうか?

'Sheet2のList先頭セルを指定(列見出しの左上隅)
  With Worksheets("Sheet2").Cells(1, "A")
    'データ行数を取得
    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コード をKeyとする
      vntKey = vntData(i, 1)
          & vbTab & vntData(i, 2)
              
      'もしKeyが重複する場合
      If .Exists(vntKey) Then
        strProm = "Keyが重複しています"
        GoTo Wayout
      Else
        'KeyとcコードをIndexに登録
        .Add vntKey, vntData(i, 3)
      End If
    Next i
  End With
  
  'Sheet1のList先頭セルを指定(列見出しの左上隅)
  Set rngResult = Worksheets("Sheet1").Cells(1, "A")
  With rngResult
    lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row
    If lngRows <= 0 Then
      strProm = "データが有りません"
      GoTo Wayout
    End If
    vntData = .Offset(1).Resize(lngRows, 2).Value
  End With
  
  '結果用配列を確保
  ReDim strResult(1 To lngRows, 1 To 1)
  'Sheet1のKeyをIndexから探索
  With dicIndex
    For i = 1 To lngRows
      vntKey = vntData(i, 1)_
          & vbTab & vntData(i, 2)
      'Keyが有ったら結果用配列に代入
      If .Exists(vntKey) Then
        strResult(i, 1) = .Item(vntKey)
      End If
    Next i
  End With
  
  '結果を出力
  With rngResult
    .Offset(1, 2).Resize(lngRows).Value = strResult
  End With
  
  strProm = "処理が完了しました"
  
Wayout:
  
  Set dicIndex = Nothing
  Set rngResult = Nothing
  
  Beep
  MsgBox strProm
  
End Sub

1 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 お礼

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