返回列表 上一主題 發帖

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

greetingsfromtw

帖子
45 
主題
10 
精華
0 
積分
59 
點名
0  
作業系統
Win7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2014-2-6 
最後登錄
2019-6-22 

論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2014-4-1 15:23 | 只看該作者

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

各位前輩大家好

假設小弟手邊有些資料,

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

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

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

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

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

希望各位前輩能予以協助,感謝
收藏 分享

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
2#
發表於 2014-4-1 19:46 | 只看該作者
本帖最後由 yen956 於 2014-4-1 19:48 編輯

試試看:
  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
複製代碼
如下圖:

TOP

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
3#
發表於 2014-4-2 04:32 | 只看該作者
回復 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

TOP

greetingsfromtw

帖子
45 
主題
10 
精華
0 
積分
59 
點名
0  
作業系統
Win7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2014-2-6 
最後登錄
2019-6-22 

論壇贊助勳章
4#
發表於 2014-4-2 11:29 | 只看該作者
十分感謝yen956大大的熱心協助,很謝謝您考量到小的權限不足,
還特地把連結貼上來,真的很感動.

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

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

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

TOP

        靜思自在 : 一個缺口的杯子，如果換一個角度看它，它仍然是圓的。
返回列表 上一主題