在符合条件的情况下循环剪切和粘贴

Question

我正试图循环以下内容

Dim x As Integer
Dim y As Integer

x = Range("AE4")
y = Range("AD4")

If x >= y Then
Range("AE4").Select
Selection.Copy
Range("AD4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Else

End If

一旦该单元格AE4被选中，然后复制或不删除，它就更大或更不适合AD4，我希望这个单元格可以转到AE5、AE6等，直到数据集的末尾。我下一步需要做什么？目前，在检查a单元格日期之前，我已经执行了其余的脚本，它的日期低于4周，然后是5周，6周，最多10周。当前正在按预期工作，检查单元格的日期，然后检查和复制数据中的第一个单元格。

完整的脚本如下。

Sub Test()

  Range("AE4").Select
    ActiveCell.Formula = _
      "=IF(RC[-2]>=TODAY()-28,""1"",IF(AND(RC[-2]<TODAY()-28,RC[-2]>=TODAY()-35),""4"",IF(AND(RC[-2]<TODAY()-35,RC[-2]>=TODAY()-42),""5"",IF(AND(RC[-2]<TODAY()-42,RC[-2]>=TODAY()-49),""6"",IF(AND(RC[-2]<TODAY()-49,RC[-2]>=TODAY()-56),""7"",IF(AND(RC[-2]<TODAY()-56,RC[-2]>=TODAY()-63),""8"",IF(AND(RC[-2]<TODAY()-63,RC[-2]>=TODAY()-70),""9"",IF(RC[-2]<TODAY()-70,""10""))))))))"
  Range("AE4").Select
  Selection.AutoFill Destination:=Range("AE4:AE200")
  Range("AE4:AE200").Select

  Dim x As Integer
  Dim y As Integer

  x = Range("AE4")
  y = Range("AD4")

  If x >= y Then
  Range("AE4").Select
  Selection.Copy
  Range("AD4").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

  Else

  End If
End Sub

Answer 1

下面是一些代码，可以做我认为你要求的事情。看起来，您很大程度上依赖于宏生成器，这往往比开发人员需要做的“选择”更多。玩一玩你的代码，看看其他帖子，看看其他人是如何做到的。

Sub Test()
    Dim ws As Worksheet
    Dim startCell as Range
    Dim fullRng As Range
    Dim thisCell As Range
    Dim leftCell as Range

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set startCell = ws.Range("AE4")
    Set fullRng = startCell.Resize(196)

    startCell.Formula = "=IF(RC[-2]>=TODAY()-28,""1"",IF(AND(RC[-2]<TODAY()-28,RC[-2]>=TODAY()-35),""4"",IF(AND(RC[-2]<TODAY()-35,RC[-2]>=TODAY()-42),""5"",IF(AND(RC[-2]<TODAY()-42,RC[-2]>=TODAY()-49),""6"",IF(AND(RC[-2]<TODAY()-49,RC[-2]>=TODAY()-56),""7"",IF(AND(RC[-2]<TODAY()-56,RC[-2]>=TODAY()-63),""8"",IF(AND(RC[-2]<TODAY()-63,RC[-2]>=TODAY()-70),""9"",IF(RC[-2]<TODAY()-70,""10""))))))))"
    startCell.AutoFill fullRng

    For Each thisCell In fullRng.Cells
        Set leftCell = thisCell.Offset(, -1)
        Debug.Print("Before If: " & thisCell.Address(False, False) & "=" & thisCell.Value2 & " v. " & leftCell.Address(False, False) & "=" & leftCell.Value2)
        If thisCell.Value2 >= leftCell.Value2 Then
            leftCell.Value2 = cell.Value2
            Debug.Print("After If: " & thisCell.Address(False, False) & "=" & thisCell.Value2 & " v. " & leftCell.Address(False, False) & "=" & leftCell.Value2)
        End If
    Next

End Sub

Answer 2

最简单的方法可能是重复你正在做的事情。与其将x和y定义为范围，您只需要一个count变量：

dim lastrow as integer
lastrow = Cells(Rows.count, "AE").End(xlUp).row 'counts the amount of cells you have with values in the row

for i = 2 to lastrow 'set 2 = whatever, but I guess you have header rows, if you want to start in the 4th row set it 4

if CELLS(i,31).Value >= CELLS(i,30).Value THEN 'the cell commands uses 1-indexed numbers to refer to cells on an x-y axis, rows go on the x axis so Cells(2,1) is "B1" for some reason.
    'insert your loop here
    Cells(i,31).Select
    Selection.Copy
    Cells(i,30).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
End if
Next i