samwang

回復 8# shuo1125

另外有幾個問題想請問
一、T1 = T & "|" & Arr(i, 6)
      >這一段是判斷是否有符合財產編號嗎? >> 若遇到財產編號相同者，只列出頭一筆。
        "|"這個的用意是..? >> 串聯2個值中間的符號，可換成其它符號皆可
二、xD1(T1) = 1: xD1(T & "/1") = xD1(T & "/1") + Arr(i, 14)
      >這段用法太高深..能夠解釋一下嗎?  >> 小記數量
三、將資料存入Arr陣列中時，此時Arr是視為物件嗎?字典xD也是物件嗎?有點無法理解...
       >>不好意思，不太知道那些定義用詞，後學是半路出家的，看了網上前輩寫法，就一樣畫葫蘆

shuo1125

回復 11# samwang

感謝samwang大大幫忙解答

能理解並用於實例已是我所不及⋯
再次感謝您的幫忙！！

准提部林

若資料多, 且每所在地的項目不超過999種, 可參考此方法:
放在同一頁, 每所在地底下加"分頁線", 使用預覽即可明白:
Xl0000031-1.rar (50.32 KB)

下載次數: 12

2021-11-25 21:56

shuo1125

回復 13# 准提部林

准大好！
因某些因素暫時無法做測試⋯
也感謝您花費精力及時間幫忙
感激不盡！

准提部林

再發一版--純篩選複製至各分表:
Xl0000031-2.rar (55.71 KB)

下載次數: 18

2021-11-28 11:16

准提部林

少算一行:
.Rows(1).Resize(.Rows.Count ).Copy xS.[a4]
改成
.Rows(2).Resize(.Rows.Count - 1).Copy xS.[a4]

shuo1125

回復 16# 准提部林

准大好！
經測試後兩種方式都無誤，
還特地花時間提供不同方法，
太感謝你了。

shuo1125

回復 16# 准提部林

准大好！
不好意思，突然想到個問題，如果我AT欄只想抓空白資料，這樣要如何多寫條件進去...
(因該欄會有S=銷售 R=報廢 O=其他等字碼，但這部分要排除)

附上圖

下載 (34.01 KB)

2021-12-2 22:21

可以再麻煩抽空幫忙解答嗎?

謝謝。

准提部林

回復 18# shuo1125

Sub TEST_A4()
Dim Arr, Brr, Cr, xD, vD, i&, j%, R&, K, T1$, T2$, TT$, N&, V%, xA As Range
tm = Timer
Call 清除
Set xD = CreateObject("Scripting.Dictionary")
Set vD = CreateObject("Scripting.Dictionary")
Arr = Range([DATA!at1], [DATA!a65536].End(xlUp))
For i = 2 To UBound(Arr)
    If Arr(i, 46) <> "" Then GoTo i01   
    T1 = Arr(i, 11): T2 = Arr(i, 6): TT = T1 & T2
    If T1 = "" Or T2 = "" Or xD(TT) > 0 Then GoTo i01
    If xD(T1) = 0 Then Set vD(T1) = CreateObject("Scripting.Dictionary")
    xD(T1) = 1: xD(TT) = 1: vD(T1)(i) = ""
i01: Next i
'--------------------------------
Application.ScreenUpdating = False
Set xA = [盤點表!A1]: Cr = Array(1, 3, 6, 8, 10, 14, 13, 12)
For Each K In vD.keys
    R = vD(K).Count: N = N + 1
    ReDim Brr(1 To R + 1, 1 To 10)
    For i = 1 To R
        V = vD(K).keys()(i - 1)
        Brr(i + 1, 5) = "小計：": Brr(i + 1, 8) = Brr(i, 8) + Arr(V, 12)
        For j = 1 To 8:  Brr(i, j) = Arr(V, Cr(j - 1)): Next
    Next i
    [盤點表!A1:j3].Copy xA
    xA(2, 2) = K: xA(2, 10) = "頁次：" & N & "/" & vD.Count
    [盤點表!a4:j4].Copy xA(4).Resize(R, 10)
    xA(4).Resize(R + 1, 10).Value = Brr
    Set xA = xA(R + 5): xA.PageBreak = xlPageBreakManual '設定分頁線
Next
MsgBox Timer - tm
End Sub

shuo1125

回復 19# 准提部林

准大好！

感謝您的解答與答覆，
測試已OK。

祝您順心~