如果满足条件，则循环剪切和粘贴
我试图循环以下
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等到数据集的末尾。 任何想法接下来我需要做什么？ 我现在已经执行了脚本的其余部分，然后再检查一个单元格date是否低于4周，然后是5周，6周大到10周。 并正在按预期方式工作，检查单元格的date，然后检查和复制数据中的第一个单元格。
完整的脚本如下。
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
下面是一些代码，将做我认为你问的。 看起来好像你依赖macros观发生器，这往往比开发人员需要做的“select”要多得多。 用你的代码玩一下，看看其他post，看看别人怎么做。
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
最简单的方法可能是一个重复你正在做的事情。 而不是定义x和y作为范围，你只需要一个计数variables：
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 xy 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