VBA 数组合并和用dict 去重数组_vba数组合并成一个数组

link管理

链接快照平台

输入网页链接，自动生成快照
标签化管理网页链接

相关文章推荐

活泼的香槟 · mtcnn人脸检测算法介绍-CSDN博客· 2 月前 ·

爱旅游的蛋挞 · 事关广州火车站改造，有最新消息！！！_腾讯新闻· 2 月前 ·

坐怀不乱的小笼包 · 春晚的仪式感，是平凡的温暖· 8 月前 ·

刚毅的芹菜 · Vue 3 Tutorial (for ...· 11 月前 ·

面冷心慈的马克杯 · [HTC J Butterfly 3] ...· 1 年前 ·

Function merge_skill1()

Dim dict1 As Object
Set dict1 = CreateObject("scripting.dictionary")
Dim arr1()
Dim arr2()
Dim arr3()
Dim arr4()
'array1 array2
'先来技能数量和id
g20 = Application.Match("技能数量", Worksheets("petbag").Range("2:2"), 0)
g21 = Application.Match("技能1", Worksheets("petbag").Range("2:2"), 0)
skill_count_s01 = Application.index(Worksheets("petbag").Columns(g20), Application.Match(s01, Worksheets("petbag").Range("a:a"), 0))
skill_count_s02 = Application.index(Worksheets("petbag").Columns(g20), Application.Match(s02, Worksheets("petbag").Range("a:a"), 0))

ReDim arr1(skill_count_s01 - 1)
For i = 1 To skill_count_s01
skill_id_s01 = Application.index(Worksheets("petbag").Columns(g21), Application.Match(s01, Worksheets("petbag").Range("a:a"), 0)).Offset(0, i - 1)
arr1(i - 1) = skill_id_s01 '下标越界？ arr1(i) 没有考虑 dim arr1这种，默认index从0开始，要注意
Debug.Print "arr1(" & i - 1 & ")=" & arr1(i - 1)
Next

ReDim arr2(skill_count_s02 - 1)
For i = 1 To skill_count_s02
skill_id_s02 = Application.index(Worksheets("petbag").Columns(g21), Application.Match(s02, Worksheets("petbag").Range("a:a"), 0)).Offset(0, i - 1)
arr2(i - 1) = skill_id_s02
Debug.Print "arr2(" & i - 1 & ")=" & arr2(i - 1)
Next

'数组合并
' arr3 = Union(arr1, arr2) 'union 只适合工作表函数
ReDim arr3(UBound(arr1))
For i = 0 To UBound(arr1)
arr3(i) = arr1(i)
' Debug.Print "arr3(" & i & ")=" & arr3(i)
Next
ReDim Preserve arr3(UBound(arr1) + UBound(arr2) + 1) '因为index从0开始
For i = UBound(arr1) + 1 To UBound(arr1) + UBound(arr2) + 1
arr3(i) = arr2(i - UBound(arr1) - 1)
' Debug.Print "arr3(" & i & ")=" & arr3(i)
Next
For i = LBound(arr3) To UBound(arr3)
Debug.Print "arr3(" & i & ")=" & arr3(i)
Next

'dict1去重

For Each i In arr3
dict1(i) = ""
Next

'遍历字典

X = 1
For Each i In dict1.keys()
ReDim Preserve arr4(1 To X) '每次改数组都要先redim redim 时记得一定要考虑是否 preserve ！！！
arr4(X) = i
X = X + 1
Next

' For i = 1 To UBound(arr4)
' Debug.Print "arr4(" & i & ")=" & arr4(i)
' Next

For i = 1 To UBound(arr4)
g30 = Application.Match("技能名", Worksheets("Petskill").Range("2:2"), 0)
g31 = Application.Match("技能效果", Worksheets("Petskill").Range("2:2"), 0)
g32 = Application.Match("技能图标", Worksheets("Petskill").Range("2:2"), 0)
g33 = Application.Match("品质", Worksheets("Petskill").Range("2:2"), 0)

skill_name_s01 = Application.index(Worksheets("Petskill").Columns(g30), Application.Match(arr4(i), Worksheets("Petskill").Range("a:a"), 0))
skill_pro_s01 = Application.index(Worksheets("Petskill").Columns(g31), Application.Match(arr4(i), Worksheets("Petskill").Range("a:a"), 0))
skill_icon_s01 = Application.index(Worksheets("Petskill").Columns(g32), Application.Match(arr4(i), Worksheets("Petskill").Range("a:a"), 0))
skill_type_s01 = Application.index(Worksheets("Petskill").Columns(g33), Application.Match(arr4(i), Worksheets("Petskill").Range("a:a"), 0))

' Debug.Print "skill_name_s01= " & skill_name_s01
' Debug.Print "skill_pro_s01= " & skill_pro_s01
' Debug.Print "skill_icon_s01= " & skill_icon_s01

'其实如果已经先写到表里，可以不用dict，直接读表，复用上面的显示函数
'还是要利用dict的去重效果，然后再存表里，是可以的。只是不直接从dict读，而是从表里再读

Controls("image" & i + 40).PictureSizeMode = fmPictureSizeModeZoom
Controls("image" & i + 40).Picture = LoadPicture(ThisWorkbook.Path & "\res\skill\" & skill_icon_s01 & ".jpg")
Controls("image" & i + 40).ControlTipText = skill_name_s01 & " " & skill_pro_s01

If skill_type_s01 = 1 Then
Controls("image" & i + 40).BorderColor = RGB(0, 0, 255)
ElseIf skill_type_s01 = 2 Then
Controls("image" & i + 40).BorderColor = RGB(255, 165, 0)
Else
Debug.Print "品质有错"
End If

Next
Call merge_skill2(UBound(arr4), arr4)

'字典的显示

End Function

Function merge_skill1() Dim dict1 As Object Set dict1 = CreateObject("scripting.dictionary") Dim arr1() Dim arr2() Dim arr3() Dim arr4() 'array1 array2 '先来技能数量和id g20 = Application.Match("技能数量", Worksheets("petbag")...

数组和字典也是 VBA 的常用到数据类型之一。但是我翻了有四五本 VBA 教程相关的书，里面都没有介绍到字典，数组到是在介绍数据类型时有介绍，而并没有提到字典。事实上，字典不是 VBA 内置的类型，它是Windows脚本语言的。但其实字典在 VBA 中也是非常重要的，它非常适用于需要进行非重复性数据的操作。我多次需要使用到字典，但很少用到数组。 1. 数组如果有学过其它编程语言，应该对数组不陌生。其实数组就是...

② 通用方法：字典去重复 Sub RecSortTest() arr = Array(5, 4, 2, 1, 5, 8, 7, 2, 7, 9, 3, 6, "22", "23", "221", 22, 23, 221, "a", "z", "c") '测试数组 ' arr = WorksheetFunct

EXCEL的真正空值是 blank，只能用=isblank() 来判断但是EXCEL里真正用到 blank的地方很少。大多数情况下只需要判断 if(A1="",) 即可。另外EXCEL的内置函数一般不能返回空值， EXCEL文档这里不好编辑，我贴了我自己文档的图片如下总结的结论如下凡是为blank的地方，EXCEL也认为是可以被认为为""。反之不成立就像文本型的数字，虽然类型是文本，但是可以直接当文本计算。也是反之不成立函数无法返回真正的blank，但是可以返回"" 比如EXCEL的直接.

在 VBA 中，可以使用一个字典对象来实现数组的快速去重。具体的做法是，将数组中的元素作为字典的键，这样重复的元素只会在字典中存在一次，最后再将字典中的键存入一个新的数组中，即可得到去重后的数组。以下是一个示例代码： ```vb Sub UniqueArr() Dim arr() As Variant arr = Array(1, 2, 3, 4, 2, 3, 5) Dim dict As New Scripting. Dict ionary Dim i As Long '将数组元素作为字典的键，去重 For i = 0 To UBound(arr) If Not dict .Exists(arr(i)) Then dict .Add arr(i), "" End If Next i '将字典中的键存入新的数组中 Dim uniqueArr() As Variant uniqueArr = dict .Keys '输出去重后的数组 For i = 0 To UBound(uniqueArr) Debug.Print uniqueArr(i) Next i End Sub 这段代码中，首先创建了一个包含重复元素的数组。然后创建了一个字典对象，并将数组中的元素作为字典的键，通过判断键是否已经存在来去重。最后将字典中的键存入一个新的数组中，并输出去重后的数组。