VBA从其他值匹配的工作簿中拉取值？
我正在使用以下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中结束。
date代表交货date。 G列中的值是交付的数量。
代码在大多数情况下都是有效的，除了有时我在D / J列中每个项目编号都有不止一次出现。
有时我得到错误的结果。 即第一行中的料号为444，然后再次出现在第三行中的情况下，该代码将检查错误的交货date或错误的交货数量。
这是因为我的代码不能确保所有的值都匹配在同一行。 我需要它来做到这一点。
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
请有人告诉我我要去哪里错了吗？
你的代码是错误的，因为不合格的范围。 考虑一下当你打开检查工作簿时会发生什么：它变成了活动工作簿，所有不合格的范围都会去的！ 当你这样做的时候：
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