VBA_依條件篩選資料

這個代碼用在人工在A表格篩選完資料(標色)，然後將篩選完的資料，選取某些欄位將相關資料會到另一個表格中。 

Sub A1_發票樣本()

'2021/12/24 

Application.ScreenUpdating = False

'sh_原則人工篩選 量及單號數較多的

Dim sh_清單 As Worksheet, sh_樣本 As Worksheet

Dim D_欄位, D_資料

Set sh_清單 = Sheets("商業發票表頭") '須先由大至小排序

Set sh_樣本 = Sheets("傳票用") '可以設定自動檢查

Set D_欄位 = CreateObject("scripting.dictionary")

Set D_資料 = CreateObject("scripting.dictionary")

With sh_清單

lc = .Range("A1").End(xlToRight).Column

lr = .Range("A1048576").End(xlUp).Row

For c = 1 To lc

D_欄位(.Cells(1, c).Text) = c

Next

For i = 2 To lr

If .Cells(i, 1).Interior.ColorIndex <> xlNone Then

in_廠商 = .Cells(i, D_欄位("協力廠商"))

in_發票日 = .Cells(i, D_欄位("商業發票日期"))

in_發票號碼 = .Cells(i, D_欄位("商業發票號碼"))

in_幣別 = .Cells(i, D_欄位("付款幣別"))

' in_條件 = .Cells(i, D_欄位("付款條件"))

in_付款 = .Cells(i, D_欄位("付款群組"))

in_序號 = .Cells(i, D_欄位("內部序號"))

in_金額 = .Cells(i, D_欄位("商業發票金額"))

D_資料(i) = Array(in_廠商, in_發票日, in_發票號碼, in_幣別, in_付款, in_序號, in_金額)

End If

Next

End With

With sh_樣本

.Cells.Delete

arr_標題 = Array("廠商", "發票日", "發票號碼", "幣別", "付款方式", "請款單序號", "發票金額")

.Range("A1").Resize(, UBound(arr_標題) + 1) = arr_標題

.Range("A2").Resize(D_資料.Count, UBound(arr_標題) + 1) = Application.Transpose(Application.Transpose(D_資料.items))

End With

End Sub