返回列表 上一主題 發帖

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

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
1# 跳轉到 »
發表於 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 
2#
發表於 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

        靜思自在 : 太陽光大、父母恩大、君子量大，小人氣大。
返回列表 上一主題