Option Explicit
Sub TEST()
Dim Brr, Y, i&, j%, xR As Range, Sh1 As Worksheet, Sh2 As Worksheet
Set Y = CreateObject("Scripting.Dictionary")
Set Sh1 = Sheets("Sheet1"): Set Sh2 = Sheets("Sheet2")
Set xR = Sh2.[A1].CurrentRegion: Brr = xR
For i = 1 To UBound(Brr)
For j = 1 To UBound(Brr, 2)
If Brr(i, j) <> "" Then Y(Brr(i, j)) = Brr(1, j)
Next
Next
Set xR = Range(Sh1.[A2], Sh1.Cells(Rows.Count, 1).End(3)): Brr = xR
For i = 1 To UBound(Brr)
Brr(i, 1) = Y(Brr(i, 1))
Next
xR.Offset(0, 3) = Brr
Set Y = Nothing: Set xR = Nothing: Set Sh1 = Nothing: Set Sh2 = Nothing
Erase Brr
End Sub
Option Explicit
Sub TEST_1()
Dim Brr, Z, i&, A As Range, j&, xA As Range
Set Z = CreateObject("Scripting.Dictionary")
Set xA = [Sheet2!A1].CurrentRegion
For Each A In xA.Offset(1, 0).SpecialCells(2)
Z(A & "") = xA.Cells(1, A.Column) & ""
Next
Brr = Range([Sheet1!A2], 工作表1.Cells(Rows.Count, "A").End(3))
For i = 1 To UBound(Brr)
Brr(i, 1) = Z(Brr(i, 1) & "")
Next
[Sheet1!D2].Resize(UBound(Brr)) = Brr
End Sub
' ↓遍歷 xA 中的標題下方每一個非空格儲存格，
For Each A In xA.Offset(1, 0).SpecialCells(2)
' ↓在字典中添加項目，Key為A儲存格值 ,Item為A儲存格所在欄位標題列的標題值
' ↓A是通用型變數,在此處是物件(儲存格),所以要以A的值納入字典,所以要加.Value或加 & ""
Z(A.Value) = xA.Cells(1, A.Column).Value
Next A
發表於 2023-5-9 16:09
| 
