Sub test()
Dim arr, 棋盤(1 To 2000, 1 To 2), i%
Dim d As Object, d1 As Object
Set d = CreateObject("scripting.dictionary")
Set d1 = CreateObject("scripting.dictionary")
arr = Range("b1", [a65536].End(xlUp))
For i = 1 To UBound(arr)
xR = arr(i, 1) & arr(i, 2)
If d.Exists(arr(i, 1)) Then
If d1.Exists(xR) Then GoTo 100
列 = d(arr(i, 1))
棋盤(列, 2) = 棋盤(列, 2) & "," & arr(i, 2)
Else
k = k + 1
d(arr(i, 1)) = k
棋盤(k, 1) = arr(i, 1)
棋盤(k, 2) = arr(i, 2)
End If
d1(xR) = arr(i, 1) & arr(i, 2)
100: Next
Range("D1").Resize(k, 2) = 棋盤
End Sub作者: 准提部林 時間: 2020-11-9 16:32
Function abc(a As Range, b As Range, c$) As String
Dim Ta$, Tb$, TT$
If a.Count <> b.Count Then abc = "error": Exit Function
If c = "" Then Exit Function
For i = 1 To a.Count
Ta = a(i, 1): Tb = b(i, 1)
If Ta <> c Or Tb = "" Then GoTo 101
If InStr("," & TT & ",", "," & Tb & ",") = 0 Then TT = TT & "," & Tb '比對b文字是否已存在于TT字串中
101: Next
abc = Mid(TT, 2)
End Function作者: Andy2483 時間: 2023-6-6 09:51
Function abc(a As Range, b As Range, c$) As String
'↑自訂函數abc().宣告變數:(a,b)是儲存格變數,c是字串變數,函數值是字串
Dim Ta$, Tb$, TT$
'↑宣告變數!(Ta,Tb,TT)是字串變數
If a.Count <> b.Count Then abc = "error": Exit Function
'↑如果a變數(儲存格)數量與 b變數(儲存格)數量不同?
'就令abc函數回傳"error"字串,然後結束程式執行
If c = "" Then Exit Function
'↑如果c變數是空字元?就結束程式執行
For i = 1 To a.Count
'↑設順迴圈!從1到 a變數(儲存格)數量
Ta = a(i, 1): Tb = b(i, 1)
'↑令Ta變數是a變數(範圍儲存格)裡的i變數列,第1欄儲存格值,
'↑令Tb變數是b變數(範圍儲存格)裡的i變數列,第1欄儲存格值
If Ta <> c Or Tb = "" Then GoTo 101
'↑如果Ta變數不等於C變數,或Tb變數是空字元,就跳到標示101位置繼續執行
If InStr("," & TT & ",", "," & Tb & ",") = 0 Then TT = TT & "," & Tb
'如果比對Tb變數文字沒有存在于TT變數字串中?
'就令Tb變數以逗號隔開加在TT變數後方
101: Next
abc = Mid(TT, 2)
'↑令abc函數回傳TT變數擷取第2字後的所有字串(因為最前面是逗號,不取)
End Function作者: Andy2483 時間: 2023-6-6 11:07
謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教
Option Explicit
Sub TEST()
Dim Brr, Crr, Y, i&, T1$, T2$
'↑宣告變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y變數是 字典
Brr = Range([B2], [A65536].End(3))
'↑令Brr變數是二維陣列,以[B2]到A欄最後一有內容的儲存格值帶入
For i = 1 To UBound(Brr)
'↑設順迴圈
T1 = Brr(i, 1): T2 = Brr(i, 2)
'↑令變數裝入迴圈陣列值,可以定義值的型態,也可縮短程式碼
If T1 = "" Or T2 = "" Then GoTo i01
'↑如果T1變數是空的或 T1變數是空的?就跳到標示i01位置繼續執行
If Y(T1) = "" Then Y(T1) = T2: GoTo i01
'↑如果以T1變數查Y字典得item值是 空的?
'是就令T1變數當key,item是T2變數,納入Y字典中,跳到標示i01位置繼續執行
If InStr("," & Y(T1) & ",", "," & T2 & ",") = 0 Then
'↑如果以T1變數提取Y字典中item值有沒有包含 T2變數?
'InStr()中的元素都以逗號包夾後再判斷,降低巧合的意外機率
Y(T1) = Y(T1) & "," & T2
'↑令T1變數在Y字典中的item值連接T2變數,中間以逗號隔開
End If
i01: Next
Brr = Range([D2], [D65536].End(3))
'↑令Brr變數是二維陣列,換裝[B2]到A欄最後一有內容的儲存格值
ReDim Crr(1 To UBound(Brr), 1 To 1)
'↑令Crr變數是 二維空陣列,縱向範圍同Brr陣列,橫向1~1
For i = 1 To UBound(Brr)
'↑設順迴圈
Crr(i, 1) = Y(Brr(i, 1))
'↑令Crr陣列值是 Brr陣列值查Y字典的item值
Next
[E2:E65536].ClearContents
'↑令儲存格舊結果清除
[E2].Resize(UBound(Crr)) = Crr
'↑令從[E2]儲存格開始寫入Crr陣列值
Set Y = Nothing: Erase Brr, Crr
'↑令釋放變數
End Sub
