如何使用 vba 增加循环范围?
how to increase ranges in loop with vba?
Sub Worksheet_Change()
Set Target = ActiveCell
Application.ScreenUpdating = False
[A1:F20].Copy
[H4].PasteSpecial Paste:=xlPasteValues, Transpose:=True
[A22:F42].Copy
[H24].PasteSpecial Paste:=xlPasteValues, Transpose:=True
[A44:F64].Copy
[H46].PasteSpecial Paste:=xlPasteValues, Transpose:=True
[A66:F86].Copy
[H68].PasteSpecial Paste:=xlPasteValues, Transpose:=True
[A88:F108].Copy
[H90].PasteSpecial Paste:=xlPasteValues, Transpose:=True
[A110:F130].Copy
[H112].PasteSpecial Paste:=xlPasteValues, Transpose:=True
[A132:F152].Copy
[H134].PasteSpecial Paste:=xlPasteValues, Transpose:=True
[A154:F174].Copy
[H156].PasteSpecial Paste:=xlPasteValues, Transpose:=True
[A176:F196].Copy
[H178].PasteSpecial Paste:=xlPasteValues, Transpose:=True
[A198:F218].Copy[H200].PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
Target.Select
End Sub
你可以试试这个:
Application.ScreenUpdating = False
[A1:F20].Copy
[H4].PasteSpecial Paste:=xlPasteValues, Transpose:=True
With [A22:F42]
For i = 1 To 9
.Offset((i - 1) * 22).Copy
[H24].Offset((i - 1) * 22).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
Next i
End With
Application.ScreenUpdating = True
Sub Worksheet_Change()
Set Target = ActiveCell
Application.ScreenUpdating = False
[A1:F20].Copy
[H4].PasteSpecial Paste:=xlPasteValues, Transpose:=True
[A22:F42].Copy
[H24].PasteSpecial Paste:=xlPasteValues, Transpose:=True
[A44:F64].Copy
[H46].PasteSpecial Paste:=xlPasteValues, Transpose:=True
[A66:F86].Copy
[H68].PasteSpecial Paste:=xlPasteValues, Transpose:=True
[A88:F108].Copy
[H90].PasteSpecial Paste:=xlPasteValues, Transpose:=True
[A110:F130].Copy
[H112].PasteSpecial Paste:=xlPasteValues, Transpose:=True
[A132:F152].Copy
[H134].PasteSpecial Paste:=xlPasteValues, Transpose:=True
[A154:F174].Copy
[H156].PasteSpecial Paste:=xlPasteValues, Transpose:=True
[A176:F196].Copy
[H178].PasteSpecial Paste:=xlPasteValues, Transpose:=True
[A198:F218].Copy[H200].PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
Target.Select
End Sub
你可以试试这个:
Application.ScreenUpdating = False
[A1:F20].Copy
[H4].PasteSpecial Paste:=xlPasteValues, Transpose:=True
With [A22:F42]
For i = 1 To 9
.Offset((i - 1) * 22).Copy
[H24].Offset((i - 1) * 22).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
Next i
End With
Application.ScreenUpdating = True