跨工作簿查找并填充数据

lengyifei

新人求助：用vlookup公式如下，=IF(COUNTIF('D:\审核\小学\双语小学2017-2018年工资表\双语小学2017-2018年工资表\2017年人代工资表汇总\[2017年03月人事代理工资表.xlsx]小学'!$C$3:$C$240,$C$5:$C$245),VLOOKUP(C5,'D:\审核\小学\双语小学2017-2018年工资表\双语小学2017-2018年工资表\2017年人代工资表汇总\[2017年03月人事代理工资表.xlsx]小学'!$C$3:$AC$240,26,0))

因为不想每次都打开原工作簿，所以想用vba代替，但不懂，所以，麻烦各位给个代码，谢谢，如果附上说明更好，因为还有好多表需要处理，万分感谢！


附件已上传，就是将源工作簿中第AB列的对应数据填到目标工作簿中第W列，如果目标工作簿中的姓名在源工作簿中没有，则为空或零，源工作簿中有四个表，最好都将已交税金对应到目标工作簿，谢谢

excel玉米

最好上传附件，否则没有人解答

lengyifei

顶一下，求解

donghui2363

把要求说的具体一些

lengyifei

就是将源表中的已交税金数据，对应复制到目标表中的已交税金，如果原表中没有这个人，就显示为空

donghui2363

已交税金数据是指的那列？是不是从源表里的四张工作表查询目标表的姓名这个对应关系？然后呢，把源表的哪列对应填过来？

syhuzh

简单的字典匹配问题，如果格式一致非常简单。
只是源工作簿中四个表，个人所得税有四个列，名字也不一样。
按这个格式写出的代码不具有通用性，也不能用到别的表上。

lengyifei

syhuzh 发表于 2019-12-3 12:07
简单的字典匹配问题，如果格式一致非常简单。
只是源工作簿中四个表，个人所得税有四个列，名字也不一样。 ...

嗯，确实，列不同，不通用，所以我让他们把源表四个表合一起了，然后我自己按照网上的代码改了改，可以引用了，但我还有个问题，如果目标表格中的姓名，在源表中不存在或没找到，让他显示零，这句代码怎么写？加到哪儿？
Sub 跨工作簿查询201701()
    Dim Sht As Worksheet
    Dim wkb_data As Workbook
    Dim fullpath As String
    Dim i As Long
    fullpath = ThisWorkbook.Path & "\2017年02月人事代理工资表.xlsx"
    Application.ScreenUpdating = False
   
    Set Sht = ThisWorkbook.Sheets("201701")
    Set wkb_data = Workbooks.Open(fullpath)
   
    With Sheets("小学")
        For i = 5 To 279
            For j = 3 To 283
                If Sht.Cells(i, 3) = .Cells(j, 3) Then
                   Sht.Cells(i, 23) = .Cells(j, 29)
                   Exit For
                End If
            Next
        Next
End With

wkb_data.Close False
Set wkb_data = Nothing
Application.ScreenUpdating = True
End Sub

syhuzh

把代码放到模块中，此代码只对附件，变动地方自行修改。

Sub 跨工作簿取数()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set d = CreateObject("scripting.dictionary")

Set wb = Workbooks.Open(ThisWorkbook.Path & "\源工作簿.xlsx")
For Each sh In wb.Sheets
    arr = sh.[a1].CurrentRegion
    For j = 1 To UBound(arr, 2)
        If InStr(arr(2, j), "个人所得税") Then k = j: Exit For
    Next
    For i = 3 To UBound(arr)
        d(arr(i, 3)) = arr(i, k)
    Next
Next
wb.Close


For i = 5 To 451        '451自行修改
    Cells(i, 23) = d(Cells(i, 3).Value)
Next

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

syhuzh

代码只针对附件。