如果单元格遵守 if 条件 vba，如何在循环内复制粘贴行

Question

我构建了一个宏来复制包含遵守 if 条件的单元格的粘贴行。此宏测量一行的 4 对单元格之间的值差异，如果差异大于所需的差异，则复制粘贴该行，即包含"有罪"值的单元格(或值，如果所有 4 个比较都不符合限制(属于(或它们(，在不同的工作表("WFRandVFR_performance"(。最后，它为"有罪"的细胞着色。除了下面提供的粘贴部分外，一切正常：

Sheets("WFRandVFR_performance").Select
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste

下面我发布宏

Sub WFRandVFR_performance()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Sheets("Tracker").Select
Dim mDiff1 As Double
mDiff1 = 0.01
Dim mDiff2 As Double
mDiff2 = 0.03
Dim mDiff3 As Double
mDiff3 = 0.01
Dim mDiff4 As Double
mDiff4 = 0.03
Sheets("Tracker").Select
For Each cell1 In Range(Range("U2"), Range("U2").End(xlDown))
If cell1.Value - cell1.Offset(0, 1).Value > mDiff1 Or cell1.Value - cell1.Offset(0, 2).Value > mDiff2 Then
cell1.EntireRow.Copy
Sheets("WFRandVFR_performance").Select
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste
End If
Next cell1
Sheets("Tracker").Select
For Each cell2 In Range(Range("AB2"), Range("AB2").End(xlDown))
If cell2.Value - cell2.Offset(0, 1).Value > mDiff3 Or cell2.Value - cell2.Offset(0, 2).Value > mDiff4 Then
cell2.EntireRow.Copy
Sheets("WFRandVFR_performance").Select
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste
End If
Next cell2
Sheets("WFRandVFR_performance").Select
Columns(4).RemoveDuplicates Columns:=Array(1)
On Error Resume Next
Columns(4).SpecialCells(xlBlanks).EntireRow.Delete
For Each cell3 In Range(Range("U2"), Range("U2").End(xlDown))
If cell3.Value - cell3.Offset(0, 1).Value > mDiff1 Then
cell3.Offset(0, 1).Interior.ColorIndex = 3
End If
If cell3.Value - cell3.Offset(0, 2).Value > mDiff2 Then
cell3.Offset(0, 2).Interior.ColorIndex = 5
End If
Next cell3
For Each cell4 In Range(Range("AB2"), Range("AB2").End(xlDown))
If cell4.Value - cell4.Offset(0, 1).Value > mDiff3 Then
cell4.Offset(0, 1).Interior.ColorIndex = 3
End If
If cell4.Value - cell4.Offset(0, 2).Value > mDiff4 Then
cell4.Offset(0, 2).Interior.ColorIndex = 5
End If
Next cell4
Sheets("WFRandVFR_performance").Select
If Not ActiveSheet.AutoFilterMode Then
ActiveSheet.Rows(1).AutoFilter
End If
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Answer 1

您可以找到最后一行：

Dim LR as Long
LR = Sheets("WFRandVFR_performance").Cells(Sheets("WFRandVFR_performance").Rows.Count, 1).End(xlUp).Row
cell1.EntireRow.Copy Sheets("WFRandVFR_performance").Range("A" & LR+1)

---

另一种选择，可能是最好的(避免复制/粘贴(：

Dim LR as Long
LR = Sheets("WFRandVFR_performance").Cells(Sheets("WFRandVFR_performance").Rows.Count, 1).End(xlUp).Row
Sheets("WFRandVFR_performance").Range("A" & LR+1).Value=cell1.EntireRow.Value

---

将其放入您的代码中：

Dim LR as Long
Sheets("WFRandVFR_performance").Rows(1).Value=Sheets("Tracker").Rows(1).Value
For Each cell1 In Range(Range("U2"), Range("U2").End(xlDown))
If cell1.Value - cell1.Offset(0, 1).Value > mDiff1 Or cell1.Value - cell1.Offset(0, 2).Value > mDiff2 Then
LR = Sheets("WFRandVFR_performance").Cells(Sheets("WFRandVFR_performance").Rows.Count, 2).End(xlUp).Row
Sheets("WFRandVFR_performance").Range("A" & LR+1).Value=cell1.EntireRow.Value
End If
Next cell1