Option Explicit
Sub TEST_1()
Dim Brr, Crr, i&, T$, V%, Y, Z$, j%
Set Y = CreateObject("Scripting.Dictionary")
Brr = Range([B2], Cells(Rows.Count, "A").End(3))
Crr = Range([E2], Cells(Rows.Count, "E").End(3))
For i = 1 To UBound(Brr)
T = Trim(Brr(i, 1)): If T = "" Then GoTo i01
V = Len(T)
For j = V To 1 Step -1
If Mid(T, j, 1) <> "0" Then
Z = Mid(T, j + 1): T = Mid(T, 1, j)
Exit For
End If
Next
T = Replace(UCase(Trim(Brr(i, 1))), "0", "") & Z
If Y.Exists(T) = Empty Then
Y(T) = Brr(i, 2)
ElseIf Y(T) <> Brr(i, 2) Then
MsgBox Brr(i, 1) & " 去0簡化後的資料欄有同編號不同商品疑慮"
Exit Sub
End If
i01:
Next
For i = 1 To UBound(Crr)
T = Trim(Crr(i, 1)): If T = "" Then GoTo i02
V = Len(T)
For j = V To 1 Step -1
If Mid(T, j, 1) <> "0" Then
Z = Mid(T, j + 1): T = Mid(T, 1, j)
Exit For
End If
Next
T = Replace(UCase(Trim(Crr(i, 1))), "0", "") & Z
Crr(i, 1) = Y(T)
i02:
Next
[I2].Resize(UBound(Crr), 1) = Crr
Erase Brr, Brr: Set Y = Nothing
End Sub作者: Andy2483 時間: 2023-3-13 10:36
Option Explicit
Sub TEST_1()
Dim Brr, Crr, Y, T$, Z$, j%, V%, i&
'↑宣告變數:(Brr,Crr,Y)是通用型變數,(T,Z)是字串變數,
'(j,V)是短整數變數,i是長整數變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y這通用型變數是 字典
Brr = Range([B2], Cells(Rows.Count, "A").End(3))
'↑令Brr是二維陣列,以[B2]到 A欄最後有內容儲存格,這兩格之間所有儲存格值帶入
Crr = Range([E2], Cells(Rows.Count, "E").End(3))
'↑令Brr是二維陣列,以[E2]到 E欄最後有內容儲存格,這兩格之間所有儲存格值帶入
For i = 1 To UBound(Brr)
'↑設順迴圈!i從1 到Brr陣列縱向最大索引列號
T = Trim(Brr(i, 1)): If T = "" Then GoTo i01
'↑令T這字串變數是i迴圈列第1欄Brr陣列值去除前後空白字元露的新字:
'如果T變數是空字元!就跳到 i01位置繼續執行
V = Len(T)
'↑令V這短整數變數是 T變數的字元數
For j = V To 1 Step -1
'↑設順迴圈!j從V變數到 1,令每個迴圈j都要-1
If Mid(T, j, 1) <> "0" Then
'↑如果T變數從j變數開始取1個字的字元不是"0"
Z = Mid(T, j + 1)
'↑令Z這字串變數是 T變數從j+1個字開始到 最後字之間的字串
Exit For
'↑跳出j迴圈
End If
Next
T = Replace(UCase(Trim(Brr(i, 1))), "0", "") & Z
'↑令T變數是 i迴圈列第1欄Brr陣列值 去除前後空白字元,經轉化英文字母為大寫,
'再將0置換為空字元,最後連接Z變數 組成新的字串變數
If Y.Exists(T) = Empty Then
'↑如果以T變數查Y字典裡沒有這key?
Y(T) = Brr(i, 2)
'↑令以T變數當key,Item是i迴圈列第2欄Brr陣列值
ElseIf Y(T) <> Brr(i, 2) Then
'↑否則如果以T變數查Y字典所回傳值不同於 i迴圈列第2欄Brr陣列值??
MsgBox Brr(i, 1) & " 去0簡化後的資料欄有同編號不同商品疑慮"
'↑跳出提示窗~~
Exit Sub
'↑結束程式執行
End If
i01:
Next
For i = 1 To UBound(Crr)
'↑設順迴圈!i從1到 Crr陣列縱向最大索引列號
T = Trim(Crr(i, 1)): If T = "" Then GoTo i02
'↑令T變數是 i迴圈列第1欄陣列值去除前後空白字元後的新字串,
'如果T變數是空字元!就跳到 i02位置繼續執行
V = Len(T)
'↑令V這短整數變數是 T變數的字元數
For j = V To 1 Step -1
'↑設順迴圈!j從V變數到 1,令每個迴圈j都要-1
If Mid(T, j, 1) <> "0" Then
'↑如果T變數從j變數開始取1個字的字元不是"0"
Z = Mid(T, j + 1)
'↑令Z這字串變數是 T變數從j+1個字開始到 最後字之間的字串
Exit For
'↑跳出j迴圈
End If
Next
T = Replace(UCase(Trim(Crr(i, 1))), "0", "") & Z
'↑令T變數是 i迴圈列第1欄Brr陣列值 去除前後空白字元,經轉化英文字母為大寫,
'再將0置換為空字元,最後連接Z變數 組成新的字串變數
Crr(i, 1) = Y(T)
'↑令i迴圈列第1欄Crr陣列值是 以T變數查Y字典所回傳的Item值
i02:
Next
[I2].Resize(UBound(Crr), 1) = Crr
'↑令[I2]擴展向下Crr陣列縱向最大索引列號數 的儲存格範圍,以Crr陣列值帶入
Erase Brr, Brr: Set Y = Nothing
'↑釋放變數
End Sub
