根据特定单元格的值重复向左复制粘贴的宏

Question

我对 VBA 完全陌生。我有一个需要将数据与日期对齐的电子表格。随着工作表的更新，日期会动态变化。

基本上，下面的宏将一列上的数据向左移动（用从 K 列到 Q 的数据替换 J 列）并清除 Q 中的现有数据。数据只是值、公式和格式的组合。下面的宏有效，但是我需要它重复自身的次数，无论单元格 E3 中的值是多少（此单元格将考虑重新对齐数据的时间延迟）。

所以基本上有人可以根据 E3 中的值（如果它大于 1）帮助这个重复这个宏部分按原样添加IF ("E3") > 1，然后在 E3 中移动Range("K6:P500") 的次数。我试过这样做，但我不知道如何重复，而且我放在一起的 IF 并没有真正起作用。

再次感谢您提供任何帮助的建议！

' Week_update Macro
'
' Keyboard Shortcut: Ctrl+Shift+W
'
    Range("K6:Q500").Select
    Selection.Copy
    Range("J6").Select
    ActiveSheet.PasteSpecial Format:=2, Link:=1, DisplayAsIcon:=False, _
        IconFileName:=False
    Range("Q6").Select
    Range("Q6:Q500").Select
    Selection.SpecialCells(xlCellTypeConstants, 1).Select
Selection.ClearContents
End Sub

Answer 1

假设您的意思是将 E3 行中包含的所有列向右移动，这将满足您的要求。

如果您使用Cells 表示法而不是A1:B1，则使用移动范围更容易。

Sub Week_update()
Dim i As Long
    i = Range("E6")
    If i > 0 Then
        ' Copy range
        Range(Cells(6, 10 + i), Cells(500, 18)).Copy
        ' Select range the same size but i columns to the right
        Range(Cells(6, 10), Cells(500, 18 - i)).Select
        ' Paste special
        ActiveSheet.PasteSpecial Format:=2, Link:=1, _
            DisplayAsIcon:=False, IconFileName:=False
        ' Clear i columns on the right
        Range(Cells(6, 18 - i), Cells(500, 18)).ClearContents
    End If
End Sub

如果您确实需要PasteSpecial。如果没有，那么您可以使用：

Sub Week_update()
Dim i As Long
    i = Range("E6")
    If i > 0 Then
        ' Copy range i columns to the left
        Range(Cells(6, 11), Cells(500, 17)).Copy( _
            Range(Cells(6, 11 - i), Cells(500, 17 - i)))
        ' Clear i columns on the right
        Range(Cells(6, 17 - i), Cells(500, 17)).ClearContents
    End If
End Sub