根据 3 个标准从不同的工作簿复制

Question

我想将数据从工作簿15B2[...]" (sheet DATA) 复制到工作簿。我从(sheet getDATA) 开始宏。如果 N 、 CI 列中的单元格为空白且 DA 列的值为 3-Incompletion em> 在里面。

不知何故，宏在第二个 if 语句之后停止并直接转到 End if 而不复制任何内容：

If InStr(.Range("DA" & LastRow7).Value2, "3-Incompletion") > 0 
And Trim(.Range("N" & LastRow7).Value2) = "" 
And Trim(.Range("CI" & LastRow7).Value2) = "" Then

我不知道这个函数到底是做什么的。它是否查看每一行并计算符合条件的行？

完整代码如下：

Sub insertINCOMPLETION()

Dim dataWB As Workbook
Dim reportWB As Workbook
Dim workB As Workbook
Dim incomplRNG As Range
Dim LastRow6 As Long
Dim LastRow7 As Long

For Each workB In Application.Workbooks
    If Left(workB.Name, 4) = "15B2" Then
        Set dataWB = workB
        Exit For
    End If
Next

If Not dataWB Is Nothing Then
    Set reportWB = ThisWorkbook

    With reportWB.Sheets("getDATA")
        LastRow6 = .Cells(.Rows.Count, "B").End(xlUp).Offset(1).Row
    End With

    With dataWB.Sheets("Data")
        LastRow7 = .Cells(.Rows.Count, "F").End(xlUp).Row

        If InStr(.Range("DA" & LastRow7).Value2, "3-Incompletion") > 0 
        And Trim(.Range("N" & LastRow7).Value2) = "" 
        And Trim(.Range("CI" & LastRow7).Value2) = "" Then
            Set incomplRNG = Application.Union(.Range("F8:F" & _ 
            LastRow7),.Range("H8:H" & LastRow7), .Range("DA8:DA" & LastRow7))
            incomplRNG.Copy
            reportWB.Sheets("getDATA").Range("B" & LastRow6).PasteSpecial xlPasteValues
        End If
    End With
End If

End Sub

我需要帮助来解决这个问题，因为我不太擅长编程 VBA。

Answer 1

尽我所能从您的问题中看出您的意图，您的代码和上面的 cmets 下面的过程应该可以满足您的需求。它未经测试，但它可能包含的任何错误都应该是您可以轻松修复的小错误（或在此处向我指出）。

第一个过程在检查数据块的最后一行后复制数据块。 Version_2 检查每一行并仅复制符合条件的行。

Option Explicit

Sub insertINCOMPLETION()

    Dim DataWb As Workbook
    Dim ReportWB As Workbook
    Dim LastReportRow As Long
    Dim LastDataRow As Long

    For Each DataWb In Application.Workbooks
        If InStr(1, DataWb.Name, "15B2", vbTextCompare) = 1 Then Exit For
    Next

    If Not DataWb Is Nothing Then
        Set ReportWB = ThisWorkbook
        With ReportWB.Sheets("getDATA")
            LastReportRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
        End With

        With DataWb.Sheets("Data")
            LastDataRow = .Cells(.Rows.Count, "F").End(xlUp).Row

            If (InStr(1, .Range("DA" & LastDataRow).Value2, "3-Incompletion", vbTextCompare) > 0) And _
                    (Trim(.Range("N" & LastDataRow).Value2) = "") And _
                    (Trim(.Range("CI" & LastDataRow).Value2) = "") Then
                .Range("F8:F" & LastDataRow).Copy ReportWB.Sheets("getDATA").Range("B" & LastReportRow)
                .Range("H8:H" & LastDataRow).Copy ReportWB.Sheets("getDATA").Range("C" & LastReportRow)
                .Range("DA8:DA" & LastDataRow).Copy ReportWB.Sheets("getDATA").Range("D" & LastReportRow)
            End If
        End With
    End If
End Sub

Sub insertINCOMPLETION_Version_2()

    Dim DataWb As Workbook
    Dim ReportWB As Workbook
    Dim LastReportRow As Long
    Dim LastDataRow As Long
    Dim R As Long

    For Each DataWb In Application.Workbooks
        If InStr(1, DataWb.Name, "15B2", vbTextCompare) = 1 Then Exit For
    Next

    If Not DataWb Is Nothing Then
        Set ReportWB = ThisWorkbook
        With ReportWB.Sheets("getDATA")
            LastReportRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
        End With

        With DataWb.Sheets("Data")
            LastDataRow = .Cells(.Rows.Count, "F").End(xlUp).Row

            Application.ScreenUpdating = False
            For R = 8 To LastDataRow
                If (InStr(1, .Cells(R, "DA").Value2, "3-Incompletion", vbTextCompare) > 0) And _
                        (Trim(.Cells(R, "N").Value2) = "") And _
                        (Trim(.Cells(R, "CI").Value2) = "") Then
                    ReportWB.Sheets("getDATA").Cells(LastReportRow, "B").Value = .Cells(R, "F").Value
                    ReportWB.Sheets("getDATA").Cells(LastReportRow, "C").Value = .Cells(R, "H").Value
                    ReportWB.Sheets("getDATA").Cells(LastReportRow, "D").Value = .Cells(R, "DA").Value
                    LastReportRow = LastReportRow + 1
                End If
            Next R
            Application.ScreenUpdating = True
        End With
    End If
End Sub