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