excel使用数据字典显示数据——宏

最新推荐文章于 2024-08-01 18:45:00 发布

xiaozaq

最新推荐文章于 2024-08-01 18:45:00 发布

阅读量6.2k

点赞数 1

分类专栏： excel 文章标签： excel 宏数据

本文链接：https://blog.csdn.net/xiaozaq/article/details/73558415

版权

excel 专栏收录该内容

4 篇文章 1 订阅

订阅专栏

对应的宏代码：

Public Sub test()
Dim Arr1, Arr2, Arr3
Dim Arr4()
Dim Dic As Object
Dim MyRng As Range
Dim i As Long

Set MyRng = Sheet1.UsedRange
Set MyRng = MyRng.Offset(1).Resize(MyRng.Rows.Count - 1, 3)
Arr1 = MyRng.Value

Set MyRng = Sheet2.UsedRange
Set MyRng = MyRng.Offset(1).Resize(MyRng.Rows.Count - 1, 3)
Arr2 = MyRng.Value

Set MyRng = Sheet3.UsedRange
Set MyRng = MyRng.Offset(1).Resize(MyRng.Rows.Count - 1, 1)
Arr3 = MyRng.Value

Set Dic = CreateObject("scripting.dictionary")

For i = 1 To UBound(Arr3)
Dic.Add Arr3(i, 1), i
Next i
ReDim Arr4(1 To UBound(Arr3), 1 To 4)

For i = 1 To UBound(Arr1)
If Dic.exists(Arr1(i, 1)) Then
Arr4(Dic.Item(Arr1(i, 1)), 1) = Arr1(i, 2)
Arr4(Dic.Item(Arr1(i, 1)), 2) = Arr1(i, 3)

End If
Next i

For i = 1 To UBound(Arr2)
If Dic.exists(Arr2(i, 1)) Then
Arr4(Dic.Item(Arr2(i, 1)), 3) = Arr2(i, 2)
Arr4(Dic.Item(Arr2(i, 1)), 4) = Arr2(i, 3)

End If
Next i


Range("B2").Resize(Dic.Count, 4) = Arr4
End Sub