|
こんばんは。
とりあえず、2例ほど作ってみました。
>-- 空白を無視するの貼り付け利用
Sub test1()
Dim i As Long
For i = 1 To Cells(65536, 1).End(xlUp).Row Step 2
With Cells(i + 1, 2).Resize(, 3)
.Copy
.Offset(-1, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=True, Transpose:=False
.ClearContents
End With
Next i
End Sub
>-- 配列利用
Sub test2()
Dim i As Long
Dim v As Variant
v = Range(Cells(1, 2), Cells(65536, 1).End(xlUp).Offset(, 4)).Value
For i = 1 To UBound(v) Step 2
v(i, 2) = v(i + 1, 1)
v(i, 4) = v(i + 1, 3)
v(i + 1, 1) = ""
v(i + 1, 3) = ""
Next i
Cells(1, 2).Resize(UBound(v), 4).Value = v
Erase v
End Sub
|
|