For Each...Next 语句未按预期运行

Question

我有几个工作表，在某些行上有各种金融报价，其中多达四行包含一个勾号（Marlett 字体字母“a”技巧）。我的 VBA 代码旨在识别勾选的行并将这些行仅传输到另一个摘要工作表。

问题是我的代码在范围内循环并复制行，但并不总是勾选的行并且经常复制它们。很难简明扼要地总结一下，最好打开带有一些数据的 excel 工作簿（我已将其匿名化，以免泄露任何个人数据）。

我在这个论坛上得到了帮助，简化了我的原始代码，这是我粘贴在下面的海报代码（顺便说一句，我非常感谢！）。

Private Sub CopyRows()

Dim cel2 As Range

ScreenUpdating = False

With Sheets("QChecklist1")
    For Each Cell In .Range("E8:E30")
        If Cell.Value = "a" Then
            Set cel2 = Sheets("QAnalysisForm").Range("B" & Rows.Count).End(xlUp).Offset(1)
            Rows(Cell.Row).Resize(, 10).Offset(, 1).Copy cel2
            cel2.Value = cel2.Value
            Set cel2 = Nothing
        End If
    Next
End With

With Sheets("QChecklist2")
    For Each Cell In .Range("E8:E30")
        If Cell.Value = "a" Then
            Set cel2 = Sheets("QAnalysisForm").Range("B" & Rows.Count).End(xlUp).Offset(1)
            Rows(Cell.Row).Resize(, 10).Offset(, 1).Copy cel2
            cel2.Value = cel2.Value
            Set cel2 = Nothing
        End If
    Next
End With

With Sheets("QChecklist3")
    For Each Cell In .Range("E8:E30")
        If Cell.Value = "a" Then
            Set cel2 = Sheets("QAnalysisForm").Range("B" & Rows.Count).End(xlUp).Offset(1)
            Rows(Cell.Row).Resize(, 10).Offset(, 1).Copy cel2
            cel2.Value = cel2.Value
            Set cel2 = Nothing
        End If
    Next
End With

With Sheets("QChecklist4")
    For Each Cell In .Range("E8:E30")
        If Cell.Value = "a" Then
            Set cel2 = Sheets("QAnalysisForm").Range("B" & Rows.Count).End(xlUp).Offset(1)
            Rows(Cell.Row).Resize(, 10).Offset(, 1).Copy cel2
            cel2.Value = cel2.Value
            Set cel2 = Nothing
        End If
    Next
End With

Sheets("QAnalysisForm").Activate
cells(1, 1).Select

On Error Resume Next


ScreenUpdating = True

End Sub

我期待这段代码在每个范围内搜索 'QChecklist' 工作表寻找'打勾' 行（这是 Marlett 字体 a's) 并将其复制并粘贴到 QAnalysisForm 工作表中。

实际发生的情况我将上传一张图片，但本质上是：

它找到（在 QChecklist1 的情况下）四个勾选的行，然后重复 第二个和第四个，然后重复整个四行两次！ 我总共得到 14 行而不是所需的 4 行！在其他 QChecklist 上 工作表（即我编码的 QChecklists 2、3 和 4）我得到 类似的重复模式。

我还希望从所有 QChecklist 中转移勾选的行 将工作表放入一个 QAnalysis（最佳报价摘要）工作表中，但 相反，代码仅从包含 宏命令按钮。我可以忍受它需要在每个工作表上单独触发，因为通常只有一两个工作表，但在我的示例测试用例中，有四个单独的工作表。

重复行图片链接：https://www.dropbox.com/s/rltdbjcui3q6843/Image%20of%20Repeating%20Rows.png?dl=0

包含报价分析工作表的 Excel 工作簿： https://www.dropbox.com/s/3bxxxs54cruyqi2/QuotationAnalysisSystemBeta.xlsm?dl=0

Answer 1

Rows 指的是 ActiveSheet。要使用“With”表，请使用.Rows

通过使用相同的代码四次，您也会为自己做一些额外的工作。这意味着您必须在多个地方进行相同的更改，否则会有出错的风险。

有几种方法可以解决这个问题，但在这种情况下，一个简单的 sub 是最简单的。

Private Sub CopyRows()
    ScreenUpdating = False

    doWork Sheets("QChecklist1")
    doWork Sheets("QChecklist2")
    doWork Sheets("QChecklist3")
    doWork Sheets("QChecklist4")

    Sheets("QAnalysisForm").Activate
    Cells(1, 1).Select

    On Error Resume Next

    ScreenUpdating = True
End Sub

Private Sub doWork(sht As Worksheet)
    Dim cel2 As Range
    With sht
        For Each Cell In .Range("E8:E30")
            If Cell.Value = "a" Then
                Set cel2 = Sheets("QAnalysisForm").Range("B" & Rows.Count).End(xlUp).Offset(1)
                .Rows(Cell.Row).Resize(, 10).Offset(, 1).Copy cel2
                cel2.Value = cel2.Value
                Set cel2 = Nothing
            End If
        Next
    End With
End Sub