[發問] [excel2003 vba]分組問題

greetingsfromtw

各位前輩大家好

假設小弟手邊有些資料,

是許多不特定長度的字串,
字串本身可能為符號或文字,但不會是數字,也不會是國字的一到九.

每個字串均以中文或英文數字做結尾,不可能同時有英文又有中文數字.
範圍為1~9或者是國字的一到九.

希望可以將它們依結尾的數字分組,
1或一為第一組,2或二為第二組,3或三為第三組,
以此類推.
若是遇到尾端沒有數字的資料,
則另外分類至"未分類",自成一組.
將分組後的結果輸出至另一頁籤, 並在組名的後方列出組內成員總數.
字串後的不論中文或英文數字均刪除.

組名在其中一個頁籤可以手動進行編輯.

檔案示意煩請參考以下連結:
http://ppt.cc/g6Fl
其中輸入資料只是為方便閱讀而排列整齊並將各組數量用成一樣,實際拿到的資料會是隨機排列的,不會全部都是英文,數量也不一定相同.

希望各位前輩能予以協助,感謝

yen956

試試看:

1. Option Base 1
   
2. Option Explicit
   
3. Private Sub CommandButton1_Click()
   
4.     Dim sh1, sh3 As Worksheet
   
5.     Dim Rng, cel As Range
   
6.     Dim strR, strL As String
   
7.     Dim i, j, r, blankCol, cnt(1 To 10), cnt2(1 To 10) As Integer
   
8.     Dim num1, num2
   
9.     num1 = Array("1", "2", "3", "4", "5", "6", "7", "8", "9")
   
10.     num2 = Array("一", "二", "三", "四", "五", "六", "七", "八", "九")
    
11.    
    
12.     Set sh1 = Sheets("輸入資料")
    
13.     Set sh3 = Sheets("分類結果")
    
14.    
    
15.     '清除 sh3 的資料
    
16.     sh3.[C3].Resize(41, 200) = ""
    
17.    
    
18.     '以你的示範檔來說, 輸入區從 [A4] 開始算, 共 14列, 9 欄
    
19.     '請自行依 實際輸入範圍 修改 Resize(14, 9) 的數據
    
20.     Set Rng = sh1.[A4].Resize(14, 9)
    
21.    
    
22.     For i = 1 To 10
    
23.        cnt(i) = 0
    
24.        cnt2(i) = 0
    
25.     Next
    
26.    
    
27.     For Each cel In Rng
    
28.    
    
29.         '若 cel 是空值, 換下一個
    
30.         If cel.Value = "" Then GoTo next1:
    
31.         
    
32.         '取得最右一碼
    
33.         strR = Right(cel, 1)
    
34.         
    
35.         '去除最右一碼
    
36.         strL = Left(cel, Len(cel) - 1)
    
37.         
    
38.         '比對 strR 在 num1 中 排第幾個
    
39.         j = Application.Match(strR, num1, 0)
    
40.         
    
41.         '若 match 產生錯誤 → 表示 strR 不在陣列 num1 中,
    
42.         If Application.IsError(j) Then
    
43.         
    
44.            '則繼續比對 strR 在 num2 中 排第幾個
    
45.             j = Application.Match(strR, num2, 0)
    
46.             
    
47.            '若 match 產生錯誤 → 表示 strR 也不在陣列 num2 中,
    
48.             If Application.IsError(j) Then
    
49.                
    
50.                 'strR 均不在 num1、num2 中,
    
51.                 '→ 表示 strR 應歸類在 unclassified 中,
    
52.                 '統計 unclassified 的總數
    
53.                 cnt(10) = cnt(10) + 1
    
54.                
    
55.                 '取得 空白儲存格 的 欄值
    
56.                 blankCol = sh3.Cells(cnt2(10) + 40, 256).End(xlToLeft).Column + 1
    
57.                 If blankCol < 3 Then blankCol = 3
    
58.                
    
59.                 sh3.Cells(cnt2(10) + 40, blankCol) = cel
    
60.                
    
61.                 '重新計算存入 unclassified 類的列值
    
62.                 cnt2(10) = cnt2(10) + 1
    
63.                 If cnt2(10) >= 3 Then cnt2(10) = 0
    
64.                
    
65.             Else
    
66.                 '統計各組的總數
    
67.                 cnt(j) = cnt(j) + 1
    
68.                
    
69.                
    
70.                 '取得 空白儲存格 的 欄值
    
71.                 blankCol = sh3.Cells(j * 4 + cnt2(j), 256).End(xlToLeft).Column + 1
    
72.                 If blankCol < 3 Then blankCol = 3
    
73.                
    
74.                 sh3.Cells(j * 4 + cnt2(j), blankCol) = strL
    
75.                
    
76.                 '重新計算存入 各組 的列值
    
77.                 cnt2(j) = cnt2(j) + 1
    
78.                 If cnt2(j) >= 3 Then cnt2(j) = 0
    
79.                
    
80.             End If
    
81.         Else
    
82.             '統計各組的總數
    
83.             cnt(j) = cnt(j) + 1
    
84.                
    
85.             '取得 空白儲存格 的 欄值
    
86.             blankCol = sh3.Cells(j * 4 + cnt2(j), 256).End(xlToLeft).Column + 1
    
87.             If blankCol < 3 Then blankCol = 3
    
88.                
    
89.             sh3.Cells(j * 4 + cnt2(j), blankCol) = strL
    
90.             
    
91.             '重新計算存入 各組 的列值
    
92.             cnt2(j) = cnt2(j) + 1
    
93.             If cnt2(j) >= 3 Then cnt2(j) = 0
    
94.         End If
    
95.         
    
96. next1:
    
97.     Next
    
98.    
    
99.     '填入各組總數
    
100.     For i = 1 To 10
     
101.         sh3.Cells(i * 4 - 1, 3) = cnt(i)
     
102.     Next
     
103. End Sub

複製代碼

如下圖:

yen956

回復 1# greetingsfromtw
補檔:
分組問題修改.7z
http://www.mediafire.com/download/gbhj146gwpj9i6d/%E5%88%86%E7%B5%84%E5%95%8F%E9%A1%8C%E4%BF%AE%E6%94%B9.7z

greetingsfromtw

十分感謝yen956大大的熱心協助,很謝謝您考量到小的權限不足,
還特地把連結貼上來,真的很感動.

您的檔案十分好用,另外有件事情希望能跟您報告一下,

若是遇到特定組別的字串數為無時,
比如說,若是所輸入的字串資料沒有任何一個是屬於第八組跟第九組,
就會產生第八組跟第九組為0的狀況,不知是否有辦法能不要顯示組數為0的組?
亦即,若是字串資料僅有第一到七組的資料的話,那麼第八組跟第九組就不要顯示.
更具體一點就是,若字串資料僅有一,三,六組的話,那麼二,五,七,八,九組也不要顯示.
當然其實這部份的話自行手動刪除即可,但假設若是遇到上千甚至是上萬筆資料,
又不能全部打在一起,必須分成多次去輸入,那可能還是會希望盡量將人工部份縮減到
只剩下key in的程度這樣...

再次感謝您及各位版大的熱心協助.