Option Explicit
Sub TEST()
Dim Brr, Crr, v, Z, i&, j, C, T$
'↑宣告變數
Set Z = CreateObject("Scripting.Dictionary")
'↑令Z變數是字典
C = Application.Match("交貨日期", [3:3], 0)
'↑令C變數是執行表格函數 Match()的回傳值 (第3列裡找 儲存格值是 "交貨日期")
If IsError(C) Then Exit Sub
'↑如果C變數是錯誤值 (Match()找不到符合的儲存格!會回傳錯誤值)
'所以C變數必須宣告為通用型變數
Brr = Range(Cells(1, C), [A65536].End(xlUp))
'↑令Brr變數是裝入儲存格值的二維陣列
For j = 1 To C
'↑設順迴圈!j從1 到C變數
T = T & Trim(Brr(2, j))
'↑令T變數是連接 迴圈列2欄陣列值去除前後空白字元後的新字串
If Trim(Brr(3, j)) = "缺額" Then Z(j) = T: T = ""
'↑如果迴圈列2欄陣列值去除前後空白字元後的新字串是 "缺額"?,
'True就令j變數為Key,Item是 T變數,納入Z字典裡,然後T變數清空
Next
For i = 4 To UBound(Brr)
'↑設順迴圈!i從4到Brr陣列縱向最大索引列號
Brr(i - 3, 1) = ""
'↑令陣列裡的1欄相對位置列陣列值是空字元
For Each j In Z.KEYS
'↑設逐項迴圈!令j變數是 Z字典裡的Keys之一
If Val(Brr(i, j)) < 0 Then Brr(i - 3, 1) = Z(j): Exit For
'↑如果迴圈列缺額欄裡的數值小於0?
'True就令陣列裡的1欄相對位置列陣列值是 j變數查Z字典回傳值
Next
Next
Cells(4, C).Resize(UBound(Brr) - 2, 1) = Brr
'↑令結果位置儲存格範圍寫入Brr陣列值
End Sub
