- 帖子
- 522
- 主題
- 36
- 精華
- 1
- 積分
- 603
- 點名
- 0
- 作業系統
- win xp sp3
- 軟體版本
- Office 2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2012-12-13
- 最後登錄
- 2021-7-11
|
7#
發表於 2014-3-6 14:44
| 只看該作者
回復 6# abi
這麼久了, 問題應該早就解決了,
我只是純練功, 順便賺點數, 請不要介意, 並請指教.- Option Base 1
- Option Explicit
- Private Sub CommandButton1_Click()
- Dim i, startL, 紀錄數 As Integer
-
- 紀錄數 = [A1].End(xlDown).Row - 1
-
- '(1) 按 1年級、2班級、3姓名 遞增排序
- '[A1].Resize(紀錄數 + 1, 14).Sort _
- Key1:=Range("A1"), Order1:=xlAscending, _
- Key2:=Range("B1"), Order1:=xlAscending, _
- Key3:=Range("D1"), Order1:=xlAscending, _
- Header:=xlYes
-
- '(2) 主程式
- i = 1
- Do
- i = i + 1
- If Cells(i, 4) = Cells(i + 1, 4) Then
- startL = i
- Do
- i = i + 1
- Loop Until Cells(i, 4) <> Cells(i + 1, 4) Or Cells(i, 1) = ""
-
- '利用 複製→選擇性貼上→轉置 的方法, 可將 橫列 與 直欄 互轉
- Cells(startL, 6).Resize(i - startL + 1, 1).Copy
-
- '不能貼在原處, 要貼到 往右一格
- Cells(startL, 7).PasteSpecial Transpose:=True
- End If
- Loop Until i > 紀錄數 Or Cells(i, 1) = ""
-
- '(3) 因 (2) 不能貼在原處, 要貼到 往右一格, 故刪 除刪除原體重
- [F2].Resize(紀錄數 + 1, 1).Delete Shift:=xlToLeft
-
- '(4) 刪除 體重的空白列
- For i = 紀錄數 + 1 To 2 Step -1
- If Cells(i, 6) = "" Then Rows(i).Delete
- Next
- '(5) 按 1年級、2班級、3座號 遞增排序
- '[A1].Resize(紀錄數 + 1, 14).Sort _
- Key1:=Range("A1"), Order1:=xlAscending, _
- Key2:=Range("B1"), Order1:=xlAscending, _
- Key3:=Range("C1"), Order1:=xlAscending, _
- Header:=xlYes
- End Sub
 |
|
