跨工作表双条件匹配并填写数据

yxh1202 · 发表于 2021-1-21 22:52

各位老师好，我有A工作簿、B工作薄。里面有相同的名称和数量，现在需要从B工作簿中活动表按照名称、数量两个条件匹配A工作簿，然后将B薄里面的单价列数据填入到A薄里面，请高手赐教。
注意A薄里面【标表2】工程量清单表的12行之前是带公式的，不用填充。

原来是手工粘贴，请指点迷津，非常感谢

3190496160 · 发表于 2021-1-22 07:52

Sub 匹配数据()
Application.ScreenUpdating = False
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Set sh = ThisWorkbook.ActiveSheet
r = sh.Cells(Rows.Count, 3).End(xlUp).Row
For i = 7 To r
If Trim(sh.Cells(i, 3)) <> "" And Trim(sh.Cells(i, 5)) <> "" Then
   zf = Trim(sh.Cells(i, 3)) & "|" & Trim(sh.Cells(i, 5))
   d(zf) = i
End If
Next i
mc = sh.Name
f = Dir(ThisWorkbook.Path & "\B工作簿.xls*")
If f = "" Then MsgBox "找不到数据源文件！": Exit Sub
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f, 0)
With wb.Worksheets(mc)
rs = sh.Cells(Rows.Count, 3).End(xlUp).Row
For i = 7 To rs
      If Trim(.Cells(i, 3)) <> "" And Trim(.Cells(i, 5)) <> "" Then
         zf_1 = Trim(.Cells(i, 3)) & "|" & Trim(.Cells(i, 5))
         m = d(zf_1)
         If m <> "" Then
            sh.Cells(m, 6) = .Cells(i, 6)
         End If
      End If
Next i
End With
wb.Close False
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160 · 发表于 2021-1-22 07:54

AB薄.rar (45.28 KB, 下载次数: 21)

yxh1202 · 发表于 2021-1-22 19:50

本帖最后由 yxh1202 于 2021-1-22 20:06 编辑

3190496160 发表于 2021-1-22 07:52
Sub 匹配数据()
Application.ScreenUpdating = False
Dim d As Object

谢谢老师，才看到。运行提示对象类型错误。我用的excel2010

3190496160 · 发表于 2021-1-23 09:01

yxh1202 发表于 2021-1-22 19:50
谢谢老师，才看到。运行提示对象类型错误。我用的excel2010

我的也是office2010，运行正常，是在不行，加我qq

		自动登录	找回密码
密码			免费注册