我想从几十个表格中找查找相应的数据

zeche457

我想从几十个表格中找查找相应的数据
具体如下：
1.通过多个表格查出一个子建编码对应的物料编码，有时一个子建编码有多个物料编码的，显示在一个单元格里
2.通过多个表格查出一个子建编码对应的物料规格和国家

3.显示应领数量和订单数量

shiruiqiang

练手，不包售后。科学计数法自己去搞吧:D
Sub text()
Dim arr, brr(1 To 1000000, 1 To 7), crr
Dim x, k
Dim dic, key
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set dic = CreateObject("scripting.dictionary")
Set fso = CreateObject("scripting.filesystemobject")

For Each f In fso.getfolder(ThisWorkbook.Path).Files
    If InStr(f.Name, ThisWorkbook.Name) = 0 Then
        With Workbooks.Open(f)
            arr = .Sheets(1).UsedRange
            .Close False
        End With
        For x = 2 To UBound(arr)
        key = arr(x, 14)
            If Not dic.exists(key) Then
            dic(key) = dic.Count + 1
            brr(dic(key), 1) = arr(x, 14)
            brr(dic(key), 2) = arr(x, 4)
            brr(dic(key), 3) = arr(x, 6)
            brr(dic(key), 4) = arr(x, 8)
            brr(dic(key), 5) = arr(x, 19)
            brr(dic(key), 6) = arr(x, 10)
            brr(dic(key), 7) = brr(dic(key), 5) & "/" & brr(dic(key), 6)
            Else
                If InStr(brr(dic(key), 2), arr(x, 4)) = 0 Then
                brr(dic(key), 2) = brr(dic(key), 2) & ";" & arr(x, 4)
                brr(dic(key), 3) = brr(dic(key), 3) & ";" & arr(x, 6)
                brr(dic(key), 4) = brr(dic(key), 4) & ";" & arr(x, 8)
                End If
            brr(dic(key), 5) = brr(dic(key), 5) + arr(x, 19)
            brr(dic(key), 6) = brr(dic(key), 6) + arr(x, 10)
            brr(dic(key), 7) = brr(dic(key), 5) & "/" & brr(dic(key), 6)
            End If
        Next
    End If
Next f

crr = Sheets(1).UsedRange
For k = 2 To UBound(crr)
If dic.exists(crr(k, 2)) Then
crr(k, 36) = brr(dic(crr(k, 2)), 2)
crr(k, 37) = brr(dic(crr(k, 2)), 3)
crr(k, 38) = brr(dic(crr(k, 2)), 4)
crr(k, 39) = brr(dic(crr(k, 2)), 7)
End If
Next
Sheets(1).UsedRange = crr
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

zeche457

shiruiqiang 发表于 2022-10-6 15:55
练手，不包售后。科学计数法自己去搞吧:D
Sub text()
Dim arr, brr(1 To 1000000, 1 To 7), crr

大神，能不能给我做一个快捷键之类的，编程我不太懂呢

shiruiqiang

zeche457 发表于 2022-10-6 16:58
大神，能不能给我做一个快捷键之类的，编程我不太懂呢

excel 里的开发工具，插入命令控件，点击设计模式，复制进去代码

小象啊啊

请参考附件。

zeche457

小象啊啊 发表于 2022-10-7 12:24
请参考附件。

非常感谢，能帮忙优化下吗？物料编码最后三位数没显示出来，还有，规格，国家，跟物料编码一样有多个的，也一样显示在一个单位格里，谢谢您

小象啊啊

你试试这次的可以了吗？

cai2532

这个也不错，学习。