標題: [發問] 資料分類問題。 [打印本頁]

---

作者: stephenlee    時間: 2019-7-11 22:48     標題: 資料分類問題。

大家好,我想請教如何用VBA 做以下要求。

下圖 A欄是我在另外一個工作表中複製過來的資料。

而我需要將資料先進行分類,再進行 計數, 顯示資料有多少筆。

但每個資料的長短都不一樣。 例如 B欄是我自己手動抽取出來的資料,

之後要再用樞紐分析表來總計出現多少筆。

我自己有個想法是 取在數字前的英文,例如AB123-01/ AB123-02/AB123 則取 AB

而LEC123-01 則取LEC, 之後再開一個新的工作表,而1個工作表 命名為 AB, 一個工作表命名為 LEC,

再將所有 包括 AB 開頭和LEC 開頭的資料,自動搬到 所屬工作表,我再用公式去拿掉最後的3位數,

再來用分析表,但有一些是 沒有 - 之後的東西, 這個我就不知道應該如何操作,卡在這了。

有沒有什麼方法可以做到根據A欄資料, 做成B欄的資料.再用分析表列出來呢,小弟是新手,望請各位大哥可以幫忙。 十萬個跪謝。

[attach]31018[/attach]

---

作者: 准提部林    時間: 2019-7-13 09:36

只是要統計分類數量, 何必一一去新增工作表???

---

作者: 准提部林    時間: 2019-7-13 11:28

採逐筆寫入, 速度較慢:
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

[attach]31026[/attach]


===============================

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)