返回列表 上一主題 發帖

[發問] 請問VBA可以篩選後，對其結果再進行進階篩選嗎?

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2026-5-26 
1# 跳轉到 »
發表於 2021-11-30 08:06 | 顯示全部帖子
回復 1# iceandy6150

請測試看看，謝謝
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

TOP

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2026-5-26 
2#
發表於 2021-11-30 15:59 | 顯示全部帖子
回復  samwang


samwang大大，可以使用
感謝你

如果你方便的話
可以下一些註解嗎?  
對於字典 還 ...
iceandy6150 發表於 2021-11-30 15:37


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

TOP

        靜思自在 : 人生最大的成就是從失敗中站起來。
返回列表 上一主題