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）并将其复制并粘贴到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

通过四次使用相同的代码，您还将为自己做一些额外的工作。这意味着您必须在多个位置进行相同的更改，否则有发生错误的风险。

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

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

对于每个...下一个语句的行为不符合预期

1 个答案: