Excel VBA For Loop – 条件不满意

我对VBA编码相当陌生，请耐心等待。

下面的子程序的目的是通过我指定的一系列单元格，如果它们符合以下标准，则将它们复制并粘贴到别处：

1. TankerCell（单元格D3）不是空的
2. TankerCell的值是数字

如果没有，我希望它运行delmacros，这将删除TankerCell所属的行，如果它不符合上述条件。

我已经宣布了其他子程序CopyandPaste ， del和IncrementDate在一个单独的模块。

CopyandPaste只是一个macros，它将预定义的select复制并粘贴到预定义的单元格中，然后删除初始范围（从中复制数据） ， IncrementDate只是将一天添加到上一个date， del删除正在复制的表中的预定义select。

到目前为止，子程序将所有项目复制并粘贴到我设置的新表格中。它不删除任何它应删除的数据。

你能发现这是为什么吗？

 Sub BulkCandP() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim i As Integer Dim LoopMax As Range, TankerCell As Range Dim NumericCheck As Boolean, EmptyCheck As Boolean Set LoopMax = Sheets("Sheet1").Range("N3") Set TankerCell = Sheets("Sheet1").Range("D3") NumericCheck = IsNumeric(TankerCell.Value) 'check if cell data is a number EmptyCheck = IsEmpty(TankerCell.Value) 'check if cell data is present For i = 1 To LoopMax.Value 'for all rows for the date range If i = 1 Then Call CopyAndPaste Call IncrementDate 'for first entry, increment date on table by 1 ElseIf i > 1 Then If (NumericCheck = False Or EmptyCheck = True) Then Call del Else Call CopyAndPaste 'bulk copy and paste values End If End If Next i Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub 

Answer 1

这是你正在尝试？

 Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim i As Integer Dim LoopMax As Range, TankerCell As Range Dim NumericCheck As Boolean, EmptyCheck As Boolean Set LoopMax = Sheets("Sheet1").Range("N3") Set TankerCell = Sheets("Sheet1").Range("D3") '~~> Run it at least once Call CopyAndPaste Call IncrementDate For i = 1 To (LoopMax.Value - 1) NumericCheck = IsNumeric(TankerCell.Value) 'check if cell data is a number EmptyCheck = IsEmpty(TankerCell.Value) 'check if cell data is present If (NumericCheck = False Or EmptyCheck = True) Then Call del Else Call CopyAndPaste 'bulk copy and paste values End If Next i Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic