Excel VBA質問箱 IV

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

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


44602 / 76732 ←次へ | 前へ→

【37145】2つのシートを比較して一致する行を別シートに移動したい
質問  小林 E-MAIL  - 06/4/23(日) 14:29 -

引用なし
パスワード
   お世話になっています。
いつも参考にさせてもらっています。

2つのシートを比較して一致する行を別シートに移動したいのですが
やり方がわからず、困っています。

以下のマクロは、請求したものが支払明細にあるかの検索マクロですが、
これを変更したいのです。

Worksheets("vicky-com")は当社のデータで、com社への請求明細です。(10列あります。)
Worksheets("com")はcom社からの支払明細です。(15列あります。)
Worksheets("vicky-com")のG列は請求番号、Worksheets("com")のI列は支払番号で
当社の請求番号を使ってもらっています。(紐付けされています。)
当社の請求番号で検索して該当したらWorksheets("hit")へ、行を移動したいのです。

Worksheets("vicky-com")の該当の行(10列分)をWorksheets("hit")のAからJ列へ、Worksheets("com")の該当の行(15列分)をKからY列へ同じ行に並べて書きたいのです。

アドバイス願えないでしょうか?
よろしくお願いいたします。
Sub test()
  Dim myArea1   As Range
  Dim myArea2   As Range
  Dim R      As Range
  Dim C      As Range
  Dim SearchKey  As String
  Dim firstAddress As String
  Dim ws1 As Worksheet
  Dim ws2 As Worksheet
  Dim ws3 As Worksheet
  
  Set ws1 = Worksheets("vicky-com")
  Set ws2 = Worksheets("com")
  Set ws3 = Worksheets("hit")
  Set myArea1 = ws1.Range("G1", Range("G65536").End(xlUp))
  Set myArea2 = ws2.Range("I:I")

  For Each R In myArea1
    SearchKey = R.Value
    Set C = myArea2.Find(What:=SearchKey, LookIn:=xlValues, LookAt:=xlWhole)
  
    If Not C Is Nothing Then
      firstAddress = C.Address
      Do
        R.Offset(, 4).Value = "該当"
        Set C = myArea2.FindNext(C)
      Loop While Not C Is Nothing And C.Address <> firstAddress
    End If
  Next R

End Sub

0 hits

【37145】2つのシートを比較して一致する行を別シートに移動したい 小林 06/4/23(日) 14:29 質問
【37148】Re:2つのシートを比較して一致する行を別シ... ハト 06/4/23(日) 15:33 回答
【37150】Re:2つのシートを比較して一致する行を別シ... Kein 06/4/23(日) 15:46 回答
【37151】Re:2つのシートを比較して一致する行を別シ... 小林 06/4/23(日) 16:07 お礼
【37155】Re:2つのシートを比較して一致する行を別シ... Kein 06/4/23(日) 17:08 発言
【37160】Re:2つのシートを比較して一致する行を別シ... 小林 06/4/23(日) 19:35 お礼
【37154】Re:2つのシートを比較して一致する行を別シ... Hirofumi 06/4/23(日) 17:03 回答
【37161】Re:2つのシートを比較して一致する行を別シ... 小林 06/4/23(日) 19:47 お礼
【37162】Re:2つのシートを比較して一致する行を別シ... Hirofumi 06/4/23(日) 20:17 回答
【37163】Re:2つのシートを比較して一致する行を別シ... 小林 06/4/23(日) 20:32 お礼

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