請問VBA可以篩選後，對其結果再進行進階篩選嗎?
[i=s] 本帖最後由 iceandy6150 於 2021-11-29 23:25 編輯 [/i]大家好
想請問VBA有沒有辦法做到
篩選後，出來的結果，在做進階篩選?
以下例子
我想做到先篩選出2021/11/23的項目
看看總共幾個符合 (紅色)
然後針對商品去進行"進階篩選" (綠色) 不重複
最後是把各種商品的總數量加起來 (藍色)
功能需求：
我要做一個查詢功能，使用者透過Inputbox，給我年月日
我要從很多很多資料中
先篩選出當天日期的資料，然後分析當天總共有多少種類的產品，加總各產品的數量
(有點類似樞紐分析)
再請各位指導，謝謝
[attach]34451[/attach]
[attach]34452[/attach]
(按鈕三)[code]Private Sub CommandButton3_Click()
Dim i
Dim a
Dim Sg As Range
i = Sheets("工作表2").Cells(1, 9).Value
a = Sheets("工作表2").Columns(2).End(xlDown).Row
Dim Rng As Range '篩選結果範圍
With Sheets("工作表2") '在工作表2中
Set Rng = .UsedRange.Range("A1:F" & a) '所有資料範圍中的A1~F底
Rng.AutoFilter Field:=1, Criteria1:="2021/11/23"
Set fa = [d2:d65536].SpecialCells(xlCellTypeVisible)(1)
Set fb = [D65536].End(xlUp)
If fa = "" Then
MsgBox "查無資料"
Sheets("工作表2").Range("A:E").AutoFilter
Exit Sub
End If
Set Sg = .Range("A" & fa.Row & ":F" & fb.Row)
'●想針對剛剛篩選出來的範圍 進行 進階篩選不重複 放到K1
Sg.AdvancedFilter xlFilterCopy, .Range("D:D"), Sheets("工作表2").Range("K1"), True
End With
End Sub[/code]最後再用 Application.SumIfs 去加總各種類的商品共有多少 [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117886&ptid=23505]1#[/url] [i]iceandy6150[/i] [/b]
請測試看看，謝謝
Sub test()
Dim Arr, Brr(), xD, T1, T4$, ND As Date, i&, j%,n%
Set xD = CreateObject("Scripting.Dictionary")
ND = InputBox("請輸入日期：", "日期", "2021/1/1")
Arr = Range([e1], [a65536].End(3))
ReDim Brr(1 To UBound(Arr), 1 To 5)
For i = 2 To UBound(Arr)
T1 = Arr(i, 1): T4 = Arr(i, 4)
If ND = T1 And xD(T4) = "" Then
n = n + 1: xD(T4) = n
For j = 1 To 5: Brr(n, j) = Arr(i, j): Next
xD(ND & "/1") = xD(ND & "/1") + Arr(i, 5)
End If
Next
[u1].CurrentRegion = ""
If n > 0 Then
Range("a1:f1").Copy [u1]
Range("u2").Resize(n, 5) = Brr
Range("x" & n + 2) = n
Range("y" & n + 2) = xD(ND & "/1")
Else
MsgBox "無資料"
End If
End Sub [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117887&ptid=23505]2#[/url] [i]samwang[/i] [/b]
samwang大大，可以使用
感謝你
如果你方便的話
可以下一些註解嗎?
對於字典 還有陣列的用法
我比較想不透
感謝你喔 [quote]回復 samwang
samwang大大，可以使用
感謝你
如果你方便的話
可以下一些註解嗎?
對於字典 還 ...
[size=2][color=#999999]iceandy6150 發表於 2021-11-30 15:37[/color] [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117888&ptid=23505][img]http://forum.twbts.com/images/common/back.gif[/img][/url][/size][/quote]
Sub test()
Dim Arr, Brr(), xD, T1, T4$, ND As Date, i&, j%, n%
Set xD = CreateObject("Scripting.Dictionary")
ND = InputBox("請輸入日期：", "日期", "2021/1/1") '需求日期
Arr = Range([e1], [a65536].End(3)) '資料裝入Arr數組
ReDim Brr(1 To UBound(Arr), 1 To 5) '符合需求的Brr數組
For i = 2 To UBound(Arr)
T1 = Arr(i, 1): T4 = Arr(i, 4)
If ND = T1 And xD(T4) = "" Then '有符合日期且商品名稱不重複
n = n + 1: xD(T4) = n '統計商品不重複數量
For j = 1 To 5: Brr(n, j) = Arr(i, j): Next '符合資料裝到Brr數組
xD(ND & "/1") = xD(ND & "/1") + Arr(i, 5) '統計數量裝字典
End If
Next
[u1].CurrentRegion = "" '清除
If n > 0 Then
Range("a1:f1").Copy [u1] 'copy抬頭
Range("u2").Resize(n, 5) = Brr '匯出Brr
Range("x" & n + 2) = n '匯出統計商品不重複數量
Range("y" & n + 2) = xD(ND & "/1") '匯出統計數量
Else
MsgBox "無資料"
End If
End Sub [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117889&ptid=23505]4#[/url] [i]samwang[/i] [/b]
非常感謝samwang大大教學
謝謝你 謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教
執行前:
[attach]36588[/attach]
輸入 2021/11/21 後按鈕執行結果:
[attach]36589[/attach]
Option Explicit
Sub TEST()
Dim Brr, Z, V1&, V2&, V3, i&, j%, R&, N&, T$
[color=SeaGreen]'↑宣告變數[/color]
Intersect(ActiveSheet.UsedRange, [U2:Z65536]).ClearContents
If IsDate([S2]) = False Then MsgBox "[S2]需輸入日期": Exit Sub
[color=SeaGreen]'↑如果[S2]儲存格值不是日期? True就跳出提示,結束程式執行[/color]
Set Z = CreateObject("Scripting.Dictionary")
[color=SeaGreen]'↑令Z變數是 字典[/color]
Brr = Range([F1], [A65536].End(xlUp))
[color=SeaGreen]'↑令Brr變數是 二維陣列,以A~F欄儲存格值帶入陣列中[/color]
For i = 2 To UBound(Brr)
[color=SeaGreen]'↑設順迴圈[/color]
T = Brr(i, 1) & "|" & Brr(i, 3) & "|" & Brr(i, 4)
[color=SeaGreen] '↑令T變數是 第1.3.4欄迴圈陣列值的組合字串,中間以"|"間隔[/color]
If InStr(T, [S2] & "|") = 0 Then GoTo i01
[color=SeaGreen] '↑如果T組合字串不符合條件? True就跳到標示i01位置繼續執行[/color]
If Z(Brr(i, 4)) = "" Then V1 = V1 + 1: Z(Brr(i, 4)) = 1
[color=SeaGreen] '↑如果商品名稱不在Z字典裡? True就令V1變數累加1後,
'將 商品名稱key對應item改為1[/color]
V2 = V2 + Brr(i, 5): V3 = V3 + Brr(i, 6)
[color=SeaGreen] '↑令V2變數累加 數量,'↑令V3變數累加 消費金額[/color]
N = Z(T)
[color=SeaGreen] '↑令N變數是 以T變數查Z字典回傳item值[/color]
If N = 0 Then
[color=SeaGreen] '↑如果N變數是 0[/color]
R = R + 1: For j = 1 To 6: Brr(R, j) = Brr(i, j): Next
[color=SeaGreen] '↑令R變數累加1,設順迴圈將迴圈列陣列值謄到指定的 R變數列[/color]
Z(T) = R: GoTo i01
[color=SeaGreen] '↑令T變數key對應item改為R變數,令跳到標示i01位置繼續執行[/color]
End If
Brr(N, 5) = Brr(N, 5) + Brr(i, 5): Brr(N, 6) = Brr(N, 6) + Brr(i, 6)
[color=SeaGreen] '↑令第二次以上出現的T變數,其數量與消費金額累加[/color]
i01: Next
If R > 0 Then R = R + 1 Else: MsgBox "無符合條件資料": Exit Sub
For j = 1 To 3: Brr(R, j) = "": Next
Brr(R, 4) = V1: Brr(R, 5) = V2: Brr(R, 6) = V3
[color=SeaGreen]'↑令加總值放在陣列裡[/color]
[U2].Resize(R, 6) = Brr
[color=SeaGreen]'↑令從[U2]擴展範圍儲存格值以Brr陣列值寫入,超過範圍的陣列值忽略[/color]
Set Z = Nothing: Erase Brr
[color=SeaGreen]'↑令釋放變數[/color]
End Sub
頁:
[1]