Option Explicit
Sub TEST() '↑
Dim Brr, Crr, Y, i&, j&, T$, K%
'↑宣告變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y變數是 字典
Brr = [A2:E5]
'↑令Brr變數是 二維陣列,以儲存格值帶入陣列中
K = UBound(Brr)
'↑令K變數是Brr陣列最大索引列號
For i = 1 To K
For j = 2 To UBound(Brr, 2)
T = Brr(i, 1) & "/" & Brr(i, j)
Y(T) = Brr(K, j)
Next
Next
'↑設順迴圈將資料區組合字串當key,item是類別,納入Y字典中
Brr = Range([C24], [B65536].End(xlUp))
'↑令Brr變數重新定義是 二維陣列,換裝新儲存格值
ReDim Crr(1 To UBound(Brr), 1 To 1)
'↑宣告Crr陣列是 二維空陣列,縱向範圍同Brr,橫向範圍1~1索引號
For i = 1 To UBound(Brr)
T = Brr(i, 1) & "/" & Brr(i, 2)
If Y(T) = "" Then
Crr(i, 1) = "E類"
Else
Crr(i, 1) = Y(T)
End If
Next
'↑設順迴圈將目標區組合字串查Y字典得到item值帶入Crr陣列中,
'如果查Y字典其item值是"",Crr陣列則寫入"E類"
[E24].Resize(UBound(Crr)) = Crr
'↑令Crr陣列值寫如結果儲存格中
Set Y = Nothing: Erase Brr, Crr
'↑令釋放變數
End Sub