添加链接
link管理
链接快照平台
  • 输入网页链接,自动生成快照
  • 标签化管理网页链接

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