求代码：利用数组+字典 进行数据的匹配

枫丹白露

求代码：
利用数组+字典 进行数据的精确查找，万分感谢


使各产量表的里的工时简称，从《数据》表里进行精确查找

如图：

zlzz1971

请用WPS运行

枫丹白露

zlzz1971 发表于 2023-1-3 17:37
请用WPS运行

没看到代码

554700056

看不懂，产量里面的跟数据有啥关系

枫丹白露

554700056 发表于 2023-1-3 18:59
看不懂，产量里面的跟数据有啥关系

就是产量表里以 工时简称为key，从《数据》表里进行精确查找

creast

请见附件, 只要是工作表名称中带有"产量"即可, 5000行的数据运算估计5秒即可完成运算

wxxydl

Sub test()
      Dim dic As Object
      Set dic = CreateObject("Scripting.Dictionary")
      arr = Worksheets("数据").Range("a5").CurrentRegion
      For i = 2 To UBound(arr)
            If Len(arr(i, 8)) Then
                  Set dic(arr(i, 8)) = CreateObject("Scripting.Dictionary")
                  For j = 4 To 9
                        If Len(arr(i, j)) And Not InStr(arr(1, j), "简称") Then dic(arr(i, 8))(arr(1, j)) = arr(i, j)
                  Next
            End If
      Next
      For Each ff In Worksheets
            If InStr(ff.Name, "产量") Then
                 ff.Select
                  lastrow = ff.Cells.Find("*", , , , xlByRows, xlPrevious).Row - 1
                  arr = Range("A5:G" & lastrow)
                  For i = 2 To UBound(arr)
                        If Len(arr(i, 6)) Then
                              If dic.Exists(arr(i, 6)) Then
                                    For j = 1 To 7
                                          If dic(arr(i, 6)).Exists(arr(1, j)) Then
                                                arr(i, j) = dic(arr(i, 6))(arr(1, j))
                                          End If
                                    Next
                              End If
                        End If
                  Next
                  Range("A5:G" & lastrow) = arr
            End If
      Next
End Sub

wxxydl

我给你简单地做了一个

枫丹白露

wxxydl 发表于 2023-1-3 22:40
我给你简单地做了一个

谢谢，可以是可以，但是我无法修改产量表的名称的，假如我把产量表名称修改为员工姓名，就不能用了

枫丹白露

creast 发表于 2023-1-3 22:09
请见附件, 只要是工作表名称中带有"产量"即可, 5000行的数据运算估计5秒即可完成运算

谢谢，运行了可以，但当数据超过1500行时，刷新就很慢了