返回列表 上一主題 發帖

[發問] 如何在多個excel檔中找出資料，然後在同一個檔中排序

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2025-7-5 
1# 跳轉到 »
發表於 2011-8-1 23:00 | 顯示全部帖子
本帖最後由 luhpro 於 2011-8-1 23:01 編輯

回復 1# eternal001
  1. Private Sub cbLoad_Click()
  2.   Dim lRow As Long, lCount As Long
  3.   Dim sPath$, sFName$, sName$, sTheName$
  4.   Dim bTranFile As Boolean
  5.   Dim vSou
  6.   
  7.   sPath = ThisWorkbook.Path    ' 指定路徑為本檔案所在的的目錄
  8.   bTranFile = False ' 紀錄是否有讀到檔案
  9.   With Me ' 本 Sheet 即 Sheet1
  10.     .Cells.Clear ' 清資料
  11.     .Cells(1, 1) = "排名" ' 標題
  12.     .Cells(1, 2) = "人名"
  13.     .Cells(1, 3) = "總分"
  14.     lRow = 2 ' 從第二列開始放資料
  15.     lCount = 0 ' 讀取資料檔案數量
  16.     sTheName = Me.Parent.Name ' 本檔案的目錄
  17.     sFName = Dir(sPath & "\*.xls")   ' 找尋第一個Excel檔案
  18.     Do While sFName <> ""    ' 執行迴圈。
  19.       If sFName <> sTheName Then ' 跳過本檔案
  20.         bTranFile = True
  21.         sName = Left(sFName, Len(sFName) - 4) ' 截取人名
  22.         sFName = sPath & "\" & sFName ' 檔案全名
  23.         Workbooks.Open Filename:=sFName, ReadOnly:=True ' 開檔
  24.         Set vSou = ActiveWorkbook.Sheets(1) '設定 Sheet(1) 物件給 vSou
  25.         Workbooks(sTheName).Activate ' 焦點切回原Sheet
  26.         .Cells(lRow, 1) = lRow - 1 ' 排名
  27.         .Cells(lRow, 2) = sName '人名
  28.         .Cells(lRow, 3) = Round(vSou.Cells(vSou.Cells(1, 1). _
  29.                           CurrentRegion.Find("總平均").Row, 2)) '總分
  30.         lRow = lRow + 1 ' 列號 + 1
  31.         lCount = lCount + 1 ' 讀取檔案數 + 1
  32.       End If
  33.       If sFName <> sTheName Then Workbooks(sName & ".xls").Close ' 關閉本檔案以外開啟的檔案
  34.       sFName = Dir    ' 尋找下一個檔案
  35.     Loop
  36.     .Range(.Cells(2, 2), .Cells(lRow, 3)).Sort Key1:=.Cells(1, 3), order1:=xlDescending ' 以總分為鍵值做排序
  37.   End With
  38.   
  39.   If Not bTranFile Then
  40.     MsgBox ("找不到任何資料檔案...")
  41.     Exit Sub
  42.   Else
  43.     MsgBox ("資料讀取完成, 共讀取 " & lCount & " 個檔案...")
  44.     Exit Sub
  45.   End If
  46. End Sub
複製代碼
排序-A.zip (13.08 KB)

TOP

        靜思自在 : 不要小看自己，因為人有無限的可能。
返回列表 上一主題