[發問] 資料分類問題。

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

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

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

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

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

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

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

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

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

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

資料分類.rar (13.66 KB)

樓主熱帖

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-22

2^#

發表於 2019-7-13 09:36 | 只看該作者

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

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-22

3^#

發表於 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

Xl0000410.rar (24.38 KB)

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

TOP