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

zyali1006

feilanga 发表于 2023-7-12 16:09
.....................

我看到sheet1出现了两次，分别是对应两个不同工作簿的sheet名字吗？
比如源数据的sheet1命名为南，写入数据的sheet1命名为北。

feilanga

WANT-T

你直接说你的需求是什么就可以了，整这1、2、3、4、条有什么吊用？单纯出来吐槽嘛？
1、数据源是什么？
2、口径是什么？
3、想要的结果是什么？
基本上任何需求，把以上三个关键点说清楚，都能很快解决！
祝您生活愉快，再见！

zyali1006

3190496160 发表于 2023-7-12 16:15

这个名字列实现出来不对哦

3190496160

zyali1006 发表于 2023-7-12 16:52
这个名字列实现出来不对哦

甚意思？？不知所云嘛，反馈问题要具体明了

feilanga

zyali1006 发表于 2023-7-12 16:36
我看到sheet1出现了两次，分别是对应两个不同工作簿的sheet名字吗？
比如源数据的sheet1命名为南，写入 ...

代码已注释，逻辑很清楚，自己看一下

zyali1006

7月.7z (15.28 KB, 下载次数: 8)

2023-7-12 16:57 上传

点击文件名下载附件

重新传了下附件，sheet有多个命名。有大神帮忙再看下吗

zyali1006

WANT-T 发表于 2023-7-12 16:45
你直接说你的需求是什么就可以了，整这1、2、3、4、条有什么吊用？单纯出来吐槽嘛？
1、数据源是什么？
2 ...

重新传了一个7月的附件，帮忙看看

zyali1006

3190496160 发表于 2023-7-12 16:55
甚意思？？不知所云嘛，反馈问题要具体明了

写入表有四列数据，有一个表头叫名字列，我点击代码运行。结果出来的是数字。
您帮忙看看

zyali1006

feilanga 发表于 2023-7-12 16:56
代码已注释，逻辑很清楚，自己看一下

是的，这个代码能运行成功。我也特地再注释看了。
Sub CX()
    Dim arr, brr
    Application.ScreenUpdating = False
    ' 创建一个字典对象
    Set dic = CreateObject("Scripting.Dictionary")
    ' 获取当前工作簿的路径
    p = ThisWorkbook.Path & "\"
    ' 遍历目标路径下所有以".xls"开头的文件
    f = Dir(p & "*.xls*")
    Do While f <> ""
        ' 排除当前工作簿并选择包含"源数据"的文件
        If f <> ThisWorkbook.Name And InStr(f, "源数据") Then
            ' 打开文件
            Set wb = Workbooks.Open(p & f, 0)
            ' 遍历文件中的所有工作表
            For Each sht In wb.Sheets
                ' 只处理索引大于0的工作表
                If sht.Index > 0 Then
                    ' 将工作表的数据存储在数组中
                    arr = sht.UsedRange
                    ' 遍历数组，并将相应数据存储到字典对象中
                    For i = 5 To UBound(arr)
                        Key = arr(i, 1) ' 第一列作为键值
                        ' 创建一个嵌套字典对象，并将对应的键值和数据存储进去
                        Set dic(Key) = CreateObject("scripting.dictionary")
                        For j = 2 To UBound(arr, 2)
                            key2 = arr(4, j) ' 第四行作为二级键值
                            dic(Key)(key2) = arr(i, j) ' 存储对应的数据到嵌套字典中
                        Next j
                    Next i
                End If
            Next sht
            ' 关闭文件，不保存
            wb.Close False
        End If
        ' 获取下一个文件
        f = Dir
    Loop

    ' 将目标数据区域存储在数组中
    brr = Sheet1.UsedRange
    ' 遍历目标数据数组，并根据字典对象进行数据替换
    For i = 3 To UBound(brr)
        For j = 3 To UBound(brr, 2)
            ' 如果第二列为空，则跳出循环
            If VBA.IsEmpty(brr(i, 2)) Then Exit For
            Key = brr(i, 2) ' 第二列作为主键
            key2 = brr(2, j) ' 第二行作为二级键值
            ' 如果字典对象中存在对应的键值和二级键值，则进行数据替换
            If dic(Key).Exists(key2) Then
                brr(i, j) = dic(Key)(key2)
            End If
        Next
    Next
    Sheet1.UsedRange = brr
    Application.ScreenUpdating = True
End Sub


可以再具体说说sheet命名吗？sheet1代表的是哪个工作簿？