Excel VBA質問箱 IV

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

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


25348 / 76732 ←次へ | 前へ→

【56725】Re:ワークシートをまたがる検索と結果自動入力
発言  Yuki  - 08/7/2(水) 10:20 -

引用なし
パスワード
   ▼まっつん さん:
こんにちは。
ディクショナリでしてみました。
Sub TEST()
  Dim Dic As Object
  Dim vA As Variant
  Dim vD1 As Variant
  Dim vD2 As Variant
  Dim i  As Long
  
  Set Dic = CreateObject("Scripting.Dictionary")
  With Worksheets("Sheet1")
    vA = .Range("A2:B" & .Range("B" & .Rows.Count).End(xlUp).Row).Value
  End With
  
  With Worksheets("Sheet2")
    vD1 = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Value
  End With
  
  With Worksheets("Sheet3")
    vD2 = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Value
  End With
  
  For i = 1 To UBound(vA)
    Dic(vA(i, 2)) = i
  Next
  
  For i = 1 To UBound(vD1)
    If Dic.Exists(vD1(i, 1)) Then
      vA(Dic(vD1(i, 1)), 1) = i + 1 & "-A"
    End If
  Next
  For i = 1 To UBound(vD2)
    If Dic.Exists(vD2(i, 1)) Then
      If vA(Dic(vD2(i, 1)), 1) = "" Then
        vA(Dic(vD2(i, 1)), 1) = i + 1 & "-B"
      Else
        vA(Dic(vD2(i, 1)), 1) = _
        vA(Dic(vD2(i, 1)), 1) & "/" & i + 1 & "-B"
                       'AとBの行番号が違う
        'vA(Dic(vD2(i, 1)), 1) & "/B" '質問通りだったら入れ替え
      End If
    End If
  Next
  Set Dic = Nothing
  
  With Worksheets("Sheet1")
    .Columns(1).ClearContents
    .Range("A2").Resize(UBound(vA)).Value = vA
  End With
End Sub
0 hits

【56722】ワークシートをまたがる検索と結果自動入力 まっつん 08/7/2(水) 0:52 質問
【56723】Re:ワークシートをまたがる検索と結果自動... Abebobo 08/7/2(水) 9:06 発言
【56726】Re:ワークシートをまたがる検索と結果自動... まっつん 08/7/2(水) 10:53 お礼
【56725】Re:ワークシートをまたがる検索と結果自動... Yuki 08/7/2(水) 10:20 発言
【56727】Re:ワークシートをまたがる検索と結果自動... まっつん 08/7/2(水) 11:01 お礼

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