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

相关文章推荐

听话的灌汤包 · 九江双蒸：大师级低醉健康广东米酒 - 中国日报网· 3 周前 ·

绅士的匕首 · 2021观澜二中高考成绩查询,深圳中学排名- ...· 3 周前 ·

豪情万千的爆米花 · 自己用的exagear模拟器百度网盘下载位置 ...· 3 月前 ·

风流的日记本 · 一月分手二月现身黄龄家中，胡洋被曝婚内不忠诚 ...· 4 月前 ·

独立的饺子 · 张桂梅：改写大山女孩命运的“擎灯人”---党建网· 5 月前 ·

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 这段代码中，首先创建了一个包含重复元素的数组。然后创建了一个字典对象，并将数组中的元素作为字典的键，通过判断键是否已经存在来去重。最后将字典中的键存入一个新的数组中，并输出去重后的数组。