Harigami
ログイン
anonymous VBA で 辞書型 (連想配列, HashMapともいう)を使う例
No License VBA
コピー
Option Explicit
Sub sample()
  Dim V4 As String
  Dim V5 As Object
  Dim V6 As Object
  Dim LastRow As Long
  Dim i As Long
  Dim key As String
  ' 画面更新を一時停止
  Application.ScreenUpdating = False
  ' 検索用の辞書
  Set V5 = CreateObject(“Scripting.Dictionary”)
  Set V6 = CreateObject(“Scripting.Dictionary”)

  ' 4列目の最終行を取得
  LastRow = Sheet(2).Cells(Rows.Count,4).End(xlUp).Row
  ' 検索用辞書を作成
  For i = 1 To LastRow
    V4 = Sheet(2).Cells(i,4)
    If V4 <> "" Then
      V5.Add V4, Sheet(2).Cells(i,5).Value
      V6.Add V4, Sheet(2).Cells(i,6).Value
    End If
  Next

  ' Sheet(1)の最終行を取得
  LastRow = Sheet(1).Cells(Rows.Count,1).End(xlUp).Row
  For i = 1 To LastRow
    key = Sheets(1).Cells(i, 5).Value
    If V5.Exists(key) Then '辞書に検索語が存在するか確認
      Sheets(1).Cells(i, 6).Value = V5.Item(key)
      Sheets(1).Cells(i, 7).Value = V6.Item(key)
    End If
  Next
  ' 画面更新を再開
  Application.ScreenUpdating = True
end Sub
Option Explicit
Sub sample()
  Dim V4 As String
  Dim V5 As Object
  Dim V6 As Object
  Dim LastRow As Long
  Dim i As Long
  Dim key As String
  ' 画面更新を一時停止
  Application.ScreenUpdating = False
  ' 検索用の辞書
  Set V5 = CreateObject(“Scripting.Dictionary”)
  Set V6 = CreateObject(“Scripting.Dictionary”)

  ' 4列目の最終行を取得
  LastRow = Sheet(2).Cells(Rows.Count,4).End(xlUp).Row
  ' 検索用辞書を作成
  For i = 1 To LastRow
    V4 = Sheet(2).Cells(i,4)
    If V4 <> "" Then
      V5.Add V4, Sheet(2).Cells(i,5).Value
      V6.Add V4, Sheet(2).Cells(i,6).Value
    End If
  Next

  ' Sheet(1)の最終行を取得
  LastRow = Sheet(1).Cells(Rows.Count,1).End(xlUp).Row
  For i = 1 To LastRow
    key = Sheets(1).Cells(i, 5).Value
    If V5.Exists(key) Then '辞書に検索語が存在するか確認
      Sheets(1).Cells(i, 6).Value = V5.Item(key)
      Sheets(1).Cells(i, 7).Value = V6.Item(key)
    End If
  Next
  ' 画面更新を再開
  Application.ScreenUpdating = True
end Sub
現在、コメントはありません。
最初のコメンターになりませんか?