- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
13#
發表於 2013-8-2 16:50
| 只看該作者
本帖最後由 GBKEE 於 2013-8-2 16:55 編輯
回復 12# Jared - Option Explicit
- Sub Ex()
- Dim Rng As String, Ar(1 To 3), A(), i As Integer, ii As Integer, X As Integer
- '要合併 三個檔案. -> Ar(1 To 3)
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- A = Array("D:\工作總表\小明.xls", "D:\工作總表\小華.xls", "D:\工作總表\小美.xls") '路徑及檔名請依需求修改
- Rng = "A1:E10" '定所有檔案在相同的範圍
- For i = 0 To UBound(A)
- With Workbooks.Open(A(i)).Sheets(1) 'With 陳述式 在一個單一物件或一個使用者自訂型態上執行一系列的陳述式。
- Ar(i + 1) = .Range(Rng).Value '二維陣列:第一維 = 工作表的列,第二維 = 工作表的欗,
- .Parent.Close
- End With
- Next
- ReDim A(1 To UBound(Ar(1), 1), 1 To UBound(Ar(1), 2)) '陣列 重新配置 維數及維數元素之上下限索引值-> "A1:E10" 的大小
- For X = 1 To UBound(Ar)
- For i = 1 To UBound(Ar(1), 2) '欄
- For ii = 1 To UBound(Ar(1), 1) '列
- If ii = 1 Or i = 1 Then
- A(ii, i) = Ar(X)(ii, i) '第1列 或 第1欗
- Else
- If Ar(X)(ii, i) <> "" Then A(ii, i) = A(ii, i) + 1 '有資料 + 1
- End If
- Next
- Next
- Next
- Workbooks("旅遊地點統計.xls").Sheets(1).Range(Rng) = A
- Application.ScreenUpdating = True '結束後更新螢幕
- Application.DisplayAlerts = True
- End Sub
複製代碼 |
|