VBA 数组合并和用dict 去重数组

最新推荐文章于 2024-01-06 10:06:01 发布

奔跑的犀牛先生

最新推荐文章于 2024-01-06 10:06:01 发布

阅读量2.6k

点赞数 1

分类专栏： # VBA实验文章标签： vba

本文链接：https://blog.csdn.net/xuemanqianshan/article/details/123005321

版权

VBA实验专栏收录该内容

69 篇文章 20 订阅

订阅专栏

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