- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 5# iceandy6150
VBA的可用不同的寫法,來達到同一效果- Option Explicit
- Private Sub CommandButton1_Click()
- Dim Rng() As Range, Ar(), xR As Variant, xC As Variant, i As Integer, ii As Integer
- Dim xRng As Range
- Application.ScreenUpdating = False
- Ar = Array("測試.XLSM", "尺寸.XLSX", "資料.XLSX")
- ReDim Rng(UBound(Ar)) '** Rng 重置元素與 Ar 一樣多
- For i = 0 To UBound(Ar)
- '**Workbooks(Ar(0)).Path ** 修改為 尺寸 , 資料 檔案的正確資料夾位置**
- If i > 0 Then Workbooks.Open (Workbooks(Ar(0)).Path & "\" & Ar(i)) '**開啟檔案
- With Workbooks(Ar(i))
- Set Rng(i) = .Sheets(1).Range("A1").CurrentRegion '**設定個檔案的資料範圍
- End With
- Next
- With Rng(0) '**測試.XLSM 清除要導入資料的範圍
- .Range(.Cells(2, 2), .Cells(.Rows.Count, .Columns.Count)) = ""
- End With
- Set xRng = Rng(0).Cells(2, 1) '**測試.XLSM: 第一個 學號
- Ar = Rng(0) '**測試.XLSM: 範圍資料導入陣列
- Do While xRng <> "" '迴圈: 學號的搜尋
- For ii = 1 To UBound(Rng)
- xR = Application.Match(xRng, Rng(ii).Columns(1), 0) '尺寸,資料 中搜尋 學號(的列號)
- If Not IsError(xR) Then '**搜尋到 學號(的列號)
- For i = 2 To Rng(0).Rows(1).Cells.Count '**測試 欄位名稱
- '**xC 傳回是否搜尋到 欄位名稱
- xC = Application.Match(Rng(0).Cells(1, i), Rng(ii).Rows(1).Cells, 0)
- If Not IsError(xC) Then Ar(xRng.Row, i) = Rng(ii).Cells(xR, xC) '**導入資料到陣列
- Next
- End If
- Next
- Set xRng = xRng.Offset(1) '**測試.XLSM: 下一個 學號
- Loop
- For i = 1 To UBound(Rng)
- Rng(i).Parent.Parent.Close '**關閉 "尺寸.XLSX", "資料.XLSX"
- Next
- Rng(0) = Ar '**陣列資料導入測試.XLSM的範圍
- Application.ScreenUpdating = True
- End Sub
|
|
發表於 2019-5-23 06:10
| 