VBA怎么在同一目录下跨工作簿实现index +match功能或者vlookup功能

zyali1006

是的，这个代码能运行，就是这个sheet1我想替换成写入表的“南”和源数据的“北”，该怎么改呢？

ykcbf1100

参与一下。

feilanga

不知所云，表不都一样吗

feilanga

zyali1006 发表于 2023-7-12 17:05
是的，这个代码能运行，就是这个sheet1我想替换成写入表的“南”和源数据的“北”，该怎么改呢？

此sheet1为户口名称 不受工作表名称修改的限制，查询表如果不是sheet1，就改为对应的表就可以了

zyali1006

feilanga 发表于 2023-7-12 17:09
不知所云，表不都一样吗

好的，还贴心的写了注释，非常感谢。我代入试下~
看来修改sheet命名并不需要改代码呀。

feilanga

zyali1006 发表于 2023-7-12 17:15
好的，还贴心的写了注释，非常感谢。我代入试下~
看来修改sheet命名并不需要改代码呀。

这里的sheet1是户口名称 括号里面的是工作表名称，工作表名称修改不影响户口名称

qdtzq

zyali1006 发表于 2023-7-12 15:59
是的，网上主要是这两个逻辑，字典或者SQL。比如这个就是用的SQL吧。https://club.excelhome.net/thread- ...

对原来的两个文件进行了一点改动，参考使用吧

3190496160

zyali1006 发表于 2023-7-12 17:01
写入表有四列数据，有一个表头叫名字列，我点击代码运行。结果出来的是数字。
您帮忙看看

Sub 导入()
Application.ScreenUpdating = False
Dim ar As Variant, br As Variant
Dim i As Long, r As Long, rs As Long
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Set sht = Sheets("sheet1")
f = Dir(ThisWorkbook.Path & "\源数据*.xls*")
If f = "" Then MsgBox "找不到源数据文件！": End
With sht
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    y = .Cells(2, Columns.Count).End(xlToLeft).Column
    If r >= 3 Then .Range(.Cells(3, 1), .Cells(r, y)) = Empty
    ar = .Range(.Cells(2, 1), .Cells(100000, y))
    For j = 3 To UBound(ar, 2)
        If Trim(ar(1, j)) <> "" Then
            d(Trim(ar(1, j))) = j
        End If
    Next j
    n = 1
    Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f, 0)
    With wb.Worksheets(1)
        br = .UsedRange.Offset(3)
    End With
    wb.Close False
    For i = 2 To UBound(br)
        If Trim(br(i, 2)) <> "" Then
            n = n + 1
            ar(n, 1) = n - 1
            ar(n, 2) = br(i, 1)
            For j = 2 To UBound(br, 2)
                If Trim(br(1, j)) <> "" Then
                    lh = d(Trim(br(1, j)))
                    If lh <> "" Then
                        ar(n, lh) = br(i, j)
                    End If
                End If
            Next j
        End If
    Next i
    If n = 1 Then MsgBox "源数据为空！": End
    .Cells(2, 1).Resize(n, UBound(ar, 2)) = ar
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

已经修改了
新建文件夹.rar (27.95 KB, 下载次数: 37)

2023-7-12 19:28 上传

点击文件名下载附件

zyali1006

qdtzq 发表于 2023-7-12 18:13
对原来的两个文件进行了一点改动，参考使用吧

这次写的更简洁了。
感觉第一次写的是类似vlookup的按几行几列来实现匹配。
这次写的类似 index +match来实现表头字段匹配。
不知道理解是否准确？

上午一直尝试代入我的表，一直报错，显示有参数未定义。

想再次请教下：是不是操作这个代码，源数据表头必须要放第一行才能实现。

这次的修改版本，我看到删除了我的源数据表合并单元格的大标题。我的源数据是系统下载的，自带合并单元格的标题的。