返回列表 上一主題 發帖

[發問] 資料分類問題。

只是要統計分類數量, 何必一一去新增工作表???
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

採逐筆寫入, 速度較慢:
Sub TEST()
Dim Sht As Worksheet, Arr, xD, i&, j%, T1$, T2$, U1&, U2&
Set Sht = ActiveSheet
Call 刪除分類工作表
Application.ScreenUpdating = False
Arr = Range([A1], Cells(Rows.Count, 1).End(xlUp))
Set xD = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(Arr)
    T1 = Split(Arr(i, 1), "-")(0):  T2 = ""
    For j = 1 To Len(T1)
        If IsNumeric(Mid(T1, j, 1)) Then T2 = Left(T1, j - 1): Exit For
    Next j
    If T2 = "" Then GoTo 101
   
    If xD(T2) = 0 Then '建立新分類工作表
       Sheets.Add(after:=Sheets(Sheets.Count)).Name = T2: Sht.Select: xD(T2) = 1
       Sheets(T2).[A1:E1] = Array("編號", "數量", "", "總數量", "=sum(B:B)")
    End If
   
    U1 = xD(T1 & "-V"): U2 = xD(T2)
    If U1 = 0 Then U2 = U2 + 1: U1 = U2: Sheets(T2).Cells(U1, 1) = T1 '新增編號
    Sheets(T2).Cells(U1, 2) = Sheets(T2).Cells(U1, 2) + 1 '累計數量
   
    xD(T1 & "-V") = U1: xD(T2) = U2  'U1-[編號]的[列位置], U2-[工作表]最後一筆[列數]
101: Next i
End Sub


Sub 刪除分類工作表()
Dim Sht As Worksheet
Application.DisplayAlerts = False
For Each Sht In Sheets
    If Sht.Name <> ActiveSheet.Name Then Sht.Delete
Next
End Sub

Xl0000410.rar (24.38 KB)


===============================
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

        靜思自在 : 不要隨心所欲,要隨心教育自己。
返回列表 上一主題