| |
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
|
|
Kein
- 06/4/23(日) 15:46 -
