- 帖子
- 824
- 主題
- 6
- 精華
- 0
- 積分
- 904
- 點名
- 0
- 作業系統
- Win 10,7
- 軟體版本
- 2019,2013,2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2010-5-3
- 最後登錄
- 2023-12-24
|
本帖最後由 luhpro 於 2011-8-1 23:01 編輯
回復 1# eternal001 - Private Sub cbLoad_Click()
- Dim lRow As Long, lCount As Long
- Dim sPath$, sFName$, sName$, sTheName$
- Dim bTranFile As Boolean
- Dim vSou
-
- sPath = ThisWorkbook.Path ' 指定路徑為本檔案所在的的目錄
- bTranFile = False ' 紀錄是否有讀到檔案
- With Me ' 本 Sheet 即 Sheet1
- .Cells.Clear ' 清資料
- .Cells(1, 1) = "排名" ' 標題
- .Cells(1, 2) = "人名"
- .Cells(1, 3) = "總分"
- lRow = 2 ' 從第二列開始放資料
- lCount = 0 ' 讀取資料檔案數量
- sTheName = Me.Parent.Name ' 本檔案的目錄
- sFName = Dir(sPath & "\*.xls") ' 找尋第一個Excel檔案
- Do While sFName <> "" ' 執行迴圈。
- If sFName <> sTheName Then ' 跳過本檔案
- bTranFile = True
- sName = Left(sFName, Len(sFName) - 4) ' 截取人名
- sFName = sPath & "\" & sFName ' 檔案全名
- Workbooks.Open Filename:=sFName, ReadOnly:=True ' 開檔
- Set vSou = ActiveWorkbook.Sheets(1) '設定 Sheet(1) 物件給 vSou
- Workbooks(sTheName).Activate ' 焦點切回原Sheet
- .Cells(lRow, 1) = lRow - 1 ' 排名
- .Cells(lRow, 2) = sName '人名
- .Cells(lRow, 3) = Round(vSou.Cells(vSou.Cells(1, 1). _
- CurrentRegion.Find("總平均").Row, 2)) '總分
- lRow = lRow + 1 ' 列號 + 1
- lCount = lCount + 1 ' 讀取檔案數 + 1
- End If
- If sFName <> sTheName Then Workbooks(sName & ".xls").Close ' 關閉本檔案以外開啟的檔案
- sFName = Dir ' 尋找下一個檔案
- Loop
- .Range(.Cells(2, 2), .Cells(lRow, 3)).Sort Key1:=.Cells(1, 3), order1:=xlDescending ' 以總分為鍵值做排序
- End With
-
- If Not bTranFile Then
- MsgBox ("找不到任何資料檔案...")
- Exit Sub
- Else
- MsgBox ("資料讀取完成, 共讀取 " & lCount & " 個檔案...")
- Exit Sub
- End If
- End Sub
 排序-A.zip (13.08 KB)
|
|
發表於 2011-8-1 23:00
| 