Question

我使用以下vba代码复制工作簿B中G列的值，并将它们粘贴到工作簿A中 - 其中值匹配。

工作簿B包含以下内容：

Column C            Column D        Column E      Column G
21/12/2016          123             444           100
12/12/2016          111             555           100
11/11/2014          123             444           0

练习册A

Column D            Column G        Column J      Column AX
21/12/2016          123             444
12/12/2016          111             555
11/11/2014          123             444

本质上，工作簿B中与每个匹配值对应的列G的值最终需要在工作簿A的列AX中结束。

日期代表交货日期。 G列中的值是交付的数量。

代码大部分时间都有效，除非有时我在D / J列中出现多个项目编号。

有时候我会得到错误的结果。即，第1行中的项目编号为444，然后在第3行再次出现。代码将检查错误的交货日期或为这些项目编号交付的错误数量。

这是因为我的代码不能确保所有值都在同一行中匹配。我需要这样做。

Option Explicit
Option Compare Text

Sub Expecting()

ActiveSheet.EnableCalculation = False
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

Dim app As New Excel.Application
app.Visible = False 'Visible is False by default, so this isn't necessary


    Dim oCell As Range, oCell2 As Range, oCell3 As Range, oCell4 As Range, targetCell As Range
    Dim ws2 As Worksheet
    Dim lastRow As Long


       If IsFileOpen("\\gb-ss04\001_DATA\WH DISPO\(5) WH SHARED DRIVE\(21) WAREHOUSE RECEIVINGS\Order Checker.xlsm") Then

        Else

        Workbooks.Open "\\gb-ss04\001_DATA\WH DISPO\(5) WH SHARED DRIVE\(21) WAREHOUSE RECEIVINGS\Order Checker.xlsm"
        End If

        If Not GetWb("Order Checker", ws2) Then Exit Sub

        lastRow = Range("J" & Rows.Count).End(xlUp).Row

        With ws2
            For Each targetCell In Range("J6:J" & lastRow)
                Set oCell = .Range("D1", .Cells(.Rows.Count, "D").End(xlUp)).Find(what:=targetCell.Value, LookIn:=xlValues, lookat:=xlWhole)
                Set oCell2 = .Range("C1", .Cells(.Rows.Count, "C").End(xlUp)).Find(what:=targetCell.Offset(0, -3).Value, LookIn:=xlValues, lookat:=xlWhole)
                Set oCell3 = .Range("E1", .Cells(.Rows.Count, "E").End(xlUp)).Find(what:=CStr(targetCell.Offset(0, -6)), LookIn:=xlValues, lookat:=xlWhole)


                If Not oCell Is Nothing And Not oCell2 Is Nothing And Not oCell3 Is Nothing Then


                    Application.EnableEvents = False

                    If oCell.Offset(0, 3) <> "0 / 0" Then
                    targetCell.Offset(0, 12).Value = oCell.Offset(0, 3)
                    Else
                    targetCell.Offset(0, 12).Value = "0"
                    End If


                    Application.EnableEvents = True

                End If



            Next
        End With






Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True



End Sub

Function GetWb(wbNameLike As String, ws As Worksheet) As Boolean
    Dim wb As Workbook
    For Each wb In Workbooks
        If wb.Name Like "*" & wbNameLike & "*" Then  '<-- check if workbook name contains "Depot Memo"
            Set ws = wb.Worksheets(2)
            Exit For
        End If
    Next
    GetWb = Not ws Is Nothing
End Function

请有人告诉我我哪里出错了吗？

Answer 1

由于范围不合格，您的代码有误。考虑打开检查器工作簿时会发生什么：它变为活动工作簿，所有不合格的范围都会转到它！当你这样做的时候：

For Each targetCell In Range("J6:J" & lastRow) ' <~~ refers to ActiveWorkbook!

With ws2
   Set oCell = .Range("D1", .Cells(.Rows.Count, "D").End(xlUp)).Find(what:=targetCell.Value, LookIn:=xlValues, lookat:=xlWhole)

在上面的查找中，您将最近打开的工作簿与自身进行比较。它没有发生之前正如你所说，是的，因为之前，WB已经打开所以你没有再打开它，所以它没有加强ActiveWorkbook属性！正如我在之前的评论中告诉你的那样，当你使用不合格的范围时，随机行为是典型的，因为它们引用Active事物（wb，ws）。

另一个错误是你没有确保匹配的值在同一行。以下情况可以，但可能需要对您的文件进行一些自定义。结构（工作表和范围的位置）

Option Explicit
Sub Expecting()
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Dim wbChecker As Workbook
    On Error Resume Next
    Set wbChecker = Workbooks("Order Checker.xlsm")
    If wbChecker Is Nothing Then Set wbChecker = Workbooks.Open("\\gb-ss04\001_DATA\WH DISPO\(5) WH SHARED DRIVE\(21) WAREHOUSE RECEIVINGS\Order Checker.xlsm")
    If wbChecker Is Nothing Then Exit Sub

    On Error GoTo cleanup
    Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Worksheets(1)
    Dim ws2 As Worksheet: Set ws2 = wbChecker.Worksheets(1)
    Dim lastRow1 As Long, lastRow2 As Long, ro1 As Long, ro2 As Long

    lastRow1 = ws1.Range("J" & ws1.Rows.Count).End(xlUp).Row
    lastRow2 = ws2.Range("D" & ws2.Rows.Count).End(xlUp).Row

    For ro2 = 1 To lastRow2
        For ro1 = 6 To lastRow1
            If ws1.Cells(ro1, "D").Value = ws2.Cells(ro2, "C").Value And _
               ws1.Cells(ro1, "G").Value = ws2.Cells(ro2, "D").Value And _
               ws1.Cells(ro1, "J").Value = ws2.Cells(ro2, "E").Value Then _
               ws1.Cells(ro1, "AX").Value = IIf(ws2.Cells(ro2, "G").Value <> "0 / 0", ws2.Cells(ro2, "G").Value, "0")
        Next
    Next

cleanup:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

VBA从值与其他值相匹配的其他工作簿中获取值？

1 个答案: