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等到数据集的末尾。任何想法我接下来需要做什么？我目前已经执行了剩余的脚本，在此检查之前，单元格日期低于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定义为范围

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

如果符合条件，则循环剪切和粘贴

2 个答案: