|
まずは、Find、Copy バージョン(副作用あり)
Sub Macro2()
Const FirstRow = 1
Const SourceCol = 1
Const TargetRow = 1
Const FirstCol = 4
Dim SourceRow As Long
Dim TargetCol As Long
Dim FoundCell As Range
TargetCol = FirstCol - 2
For SourceRow = FirstRow To Cells(Rows.Count, SourceCol).End(xlUp).Row
' Findメソッドバージョン
Set FoundCell = Range(Cells(TargetRow, FirstCol), Cells(TargetRow, TargetCol)) _
.Find(What:=Cells(SourceRow, SourceCol).Value, LookIn:=xlValues, LookAt:=xlWhole)
If FoundCell Is Nothing Then
TargetCol = TargetCol + 2
' Copyバージョン
Cells(SourceRow, SourceCol).Resize(1, 2).Copy _
Destination:=Cells(TargetRow, TargetCol).Resize(1, 2)
Else
' Copyバージョン
Cells(SourceRow, SourceCol + 1).Copy
FoundCell.Offset(0, 1).PasteSpecial Operation:=xlAdd
Application.CutCopyMode = False
End If
Next SourceRow
End Sub
|
|