Excel VBA質問箱 IV

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

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


46602 / 76732 ←次へ | 前へ→

【35100】Re:VLOOKUP関数をVBAで使うにはどうした...
回答  Kein  - 06/2/21(火) 13:35 -

引用なし
パスワード
   速度を期待することは出来ませが、ロジックとしては

Sub Test_Calc2()
  Dim Sh As Worksheet, Sh2 As Worksheet
  Dim MyR As Range, C As Range
  Dim Ck As Variant

  Set Sh = Worksheets("Sheet1")
  Set Sh2 = Worksheets("Sheet2")
  On Error GoTo ELine
  Set MyR = Sh.Range("B:B").SpecialCells(2)
  On Error GoTo 0
  For Each C In Sh2.Range("A1", Sh2.Range("A65536").End(xlUp))
   Ck = Application.Match(C.Value, Sh.Range("A:A"), 0)
   If Not IsError(Ck) Then
     If Not Intersect(Sh.Cells(Ck, 2), MyR) Is Nothing Then
       C.Offset(, 1).Value = Sh.Cells(Ck, 2).Value
     End If
   End If
  Next
ELine:
  Set MyR = Nothing: Set Sh = Nothing: Set Sh2 = Nothing
End Sub

あるいは、検索元と検索先を逆にすることが可能なら

Sub Test_Calc3()
  Dim Sh As Worksheet, Sh2 As Worksheet
  Dim MyR As Range, C As Range
  Dim Ck As Variant

  Set Sh = Worksheets("Sheet1")
  Set Sh2 = Worksheets("Sheet2")
  On Error GoTo ELine
  Set MyR = Sh.Range("B:B").SpecialCells(2)
  On Error GoTo 0
  For Each C In MyR
   Ck = Application _
   .Match(C.Offset(, -1).Value, Sh2.Range("A:A"), 0)
   If Not IsError(Ck) Then
    Sh2.Cells(Ck, 2).Value = C.Value
   End If
  Next
ELine:
  Set MyR = Nothing: Set Sh = Nothing: Set Sh2 = Nothing
End Sub

というコードも考えられます。
3 hits

【35054】VLOOKUP関数をVBAで使うにはどうしたらい... ぷうたろう 06/2/20(月) 13:43 質問
【35061】Re:VLOOKUP関数をVBAで使うにはどうしたら... Kein 06/2/20(月) 15:27 回答
【35063】Re:VLOOKUP関数をVBAで使うにはどうした... ぷうたろう 06/2/20(月) 15:40 お礼
【35080】Re:VLOOKUP関数をVBAで使うにはどうした... ぷうたろう 06/2/21(火) 10:16 質問
【35100】Re:VLOOKUP関数をVBAで使うにはどうした... Kein 06/2/21(火) 13:35 回答
【35107】Re:VLOOKUP関数をVBAで使うにはどうした... ぷうたろう 06/2/21(火) 14:36 お礼

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