Excel - 循环格式化复制和粘贴
Excel - Loop Through Formatting Copy & Paste
我实际上是在尝试从我的 Column(A) Row(3) 中获取格式并复制其格式并将格式粘贴到其下方的行。有没有更好的方法来编写我的循环?
Sub Copy_Formatting()
Dim rNum As Long
For rNum = 3 To 26
If Range("A" & rNum) <> "" Then
Range(("A" & rNum), ("B" & rNum)).Copy
Range(("A" & rNum + 1), ("B" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("C" & rNum), ("D" & rNum)).Copy
Range(("C" & rNum + 1), ("D" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("E" & rNum), ("F" & rNum)).Copy
Range(("E" & rNum + 1), ("F" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("G" & rNum), ("H" & rNum)).Copy
Range(("G" & rNum + 1), ("H" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("I" & rNum), ("J" & rNum)).Copy
Range(("I" & rNum + 1), ("J" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("K" & rNum), ("L" & rNum)).Copy
Range(("K" & rNum + 1), ("L" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("M" & rNum), ("N" & rNum)).Copy
Range(("M" & rNum + 1), ("N" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("O" & rNum), ("P" & rNum)).Copy
Range(("O" & rNum + 1), ("P" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("Q" & rNum), ("R" & rNum)).Copy
Range(("Q" & rNum + 1), ("R" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("S" & rNum), ("T" & rNum)).Copy
Range(("S" & rNum + 1), ("T" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("U" & rNum), ("V" & rNum)).Copy
Range(("U" & rNum + 1), ("V" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("W" & rNum), ("X" & rNum)).Copy
Range(("W" & rNum + 1), ("X" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("Y" & rNum), ("Z" & rNum)).Copy
Range(("Y" & rNum + 1), ("Z" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("AA" & rNum), ("AB" & rNum)).Copy
Range(("AA" & rNum + 1), ("AB" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("AC" & rNum), ("AD" & rNum)).Copy
Range(("AC" & rNum + 1), ("AD" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("AE" & rNum), ("AF" & rNum)).Copy
Range(("AE" & rNum + 1), ("AF" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("AG" & rNum), ("AH" & rNum)).Copy
Range(("AG" & rNum + 1), ("AH" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range("AI" & rNum).Copy
Range("AI" & rNum + 1).PasteSpecial (xlPasteFormats)
Application.CutCopyMode = False
Else: Exit Sub
End If
Next rNum
End Sub
我不会使用循环...立即执行:
Sub test()
Rows("3:3").Select
Application.CutCopyMode = False
Selection.Copy
Rows("4:26").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End Sub
a) select 源行 - 整行,而不是一次只有 1 个单元格。
b) 复制源行(只做一次,无需重复)
c) 将格式(仅)传递给所有目标行...一个操作...
我实际上是在尝试从我的 Column(A) Row(3) 中获取格式并复制其格式并将格式粘贴到其下方的行。有没有更好的方法来编写我的循环?
Sub Copy_Formatting()
Dim rNum As Long
For rNum = 3 To 26
If Range("A" & rNum) <> "" Then
Range(("A" & rNum), ("B" & rNum)).Copy
Range(("A" & rNum + 1), ("B" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("C" & rNum), ("D" & rNum)).Copy
Range(("C" & rNum + 1), ("D" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("E" & rNum), ("F" & rNum)).Copy
Range(("E" & rNum + 1), ("F" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("G" & rNum), ("H" & rNum)).Copy
Range(("G" & rNum + 1), ("H" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("I" & rNum), ("J" & rNum)).Copy
Range(("I" & rNum + 1), ("J" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("K" & rNum), ("L" & rNum)).Copy
Range(("K" & rNum + 1), ("L" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("M" & rNum), ("N" & rNum)).Copy
Range(("M" & rNum + 1), ("N" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("O" & rNum), ("P" & rNum)).Copy
Range(("O" & rNum + 1), ("P" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("Q" & rNum), ("R" & rNum)).Copy
Range(("Q" & rNum + 1), ("R" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("S" & rNum), ("T" & rNum)).Copy
Range(("S" & rNum + 1), ("T" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("U" & rNum), ("V" & rNum)).Copy
Range(("U" & rNum + 1), ("V" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("W" & rNum), ("X" & rNum)).Copy
Range(("W" & rNum + 1), ("X" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("Y" & rNum), ("Z" & rNum)).Copy
Range(("Y" & rNum + 1), ("Z" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("AA" & rNum), ("AB" & rNum)).Copy
Range(("AA" & rNum + 1), ("AB" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("AC" & rNum), ("AD" & rNum)).Copy
Range(("AC" & rNum + 1), ("AD" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("AE" & rNum), ("AF" & rNum)).Copy
Range(("AE" & rNum + 1), ("AF" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range(("AG" & rNum), ("AH" & rNum)).Copy
Range(("AG" & rNum + 1), ("AH" & rNum + 1)).PasteSpecial (xlPasteFormats)
Range("AI" & rNum).Copy
Range("AI" & rNum + 1).PasteSpecial (xlPasteFormats)
Application.CutCopyMode = False
Else: Exit Sub
End If
Next rNum
End Sub
我不会使用循环...立即执行:
Sub test()
Rows("3:3").Select
Application.CutCopyMode = False
Selection.Copy
Rows("4:26").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End Sub
a) select 源行 - 整行,而不是一次只有 1 个单元格。
b) 复制源行(只做一次,无需重复)
c) 将格式(仅)传递给所有目标行...一个操作...