Excel VBA質問箱 IV

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

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


44597 / 76732 ←次へ | 前へ→

【37150】Re:2つのシートを比較して一致する行を別シートに移動したい
回答  Kein  - 06/4/23(日) 15:46 -

引用なし
パスワード
   Worksheets("vicky-com")の AG列 を作業列として数式を埋め込んで検索し、
ヒットした行を転記処理する。というコードなら・・

Sub Data_Serch_Copy()
  Dim MyR As Range, CpR As Range
  Dim C As Range, PsR As Range
  Dim Cr As Long
  Dim MyV1 As Variant, MyV2 As Variant

  With Worksheets("vicky-com")
   Set MyR = .Range("G1", .Range("G65536").End(xlUp)) _
   .Offset(, 26)
   Set CpR = .Range("A:J")
  End With
  MyR.Formula = "=MATCH($G1,com!$I:$I,0)"
  On Error GoTo ELinee
  Set MyR = MyR.SpecialCells(3, 1)
  On Error GoTo 0
  'Worksheets("hit").Cells.ClearContents
  '↑コピー先のデータを全て入れ替えする場合は、コメントを外す。
  For Each C In MyR
   Cr = C.Value
   MyV1 = Intersect(C.EntireRow, CpR).Value
   MyV2 = Worksheets("com").Cells(Cr, 1).Resize(, 15).Value
   Set PsR = Worksheets("hit").Range("A65536").End(xlUp)
   PsR.Offset(1).Resize(, 10).Value = MyV1
   PsR.Offset(1, 10).Resize(, 15).Value = MyV2
   Set PsR = Nothing
  Next
ELine:
  Set MyR = Nothing: Set CpR = Nothing
  Worksheets("vicky-com").Range("AG:AG").ClearContents
  If Err.Number <> 0 Then
   MsgBox "請求番号がヒットした支払番号はありませんでした", 48
  Else
   Worksheets("hit").Activate
  End If
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 お礼

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