oak0723-1

回復 5# Andy2483


    不知為何
執行會卡在檔案002
麻煩解惑

oak0723-1

回復 5# Andy2483


    知道為何
執行時會卡住在002檔案
是excel版本因素嗎?還是檔名字型?

Andy2483

回復 12# oak0723-1

謝謝前輩回復
學習到的解決方案是需將數字轉化為文字,用CStr()函數處理成.Sheets(CStr(Arr(i, 2)))或 .Sheets(Arr(i, 2) & "")
https://learn.microsoft.com/zh-t ... onversion-functions
後學考慮不周全,謝謝前輩指點
後學另建議以變數宣告為字串盛裝方案如下

Option Explicit
Sub TEST()
Dim Arr, i%, Ph$, xS As Worksheet, xB As Workbook, K%, T1$, T2$
Application.ScreenUpdating = False
Set xB = ThisWorkbook: Ph = xB.Path & "\"
Arr = Range([順序!E2], [順序!C65536].End(3))
Sheets("集中").Cells.Clear
For i = 1 To UBound(Arr)
   T1 = Arr(i, 1): T2 = Arr(i, 2)
   On Error Resume Next
   Set xS = Workbooks(T1 & ".xlsx").Sheets(T2)
   If Err.Number <> 0 Then
      Set xS = Workbooks.Open(Ph & T1 & ".xlsx").Sheets(T2)
      K = 1
   End If
   On Error GoTo 0
   If xS Is Nothing Then
      MsgBox T1 & " 活頁簿, " & T2 & " 工作表不存在!結束執行"
      Exit Sub
   End If
   xS.[A:I].Copy xB.Sheets("集中").Cells(1, Arr(i, 3))
   If K = 1 Then xS.Parent.Close 0: K = 0
   Set xS = Nothing
Next
Set xB = Nothing: Erase Arr
End Sub

Andy2483

回復 10# singo1232001


    謝謝前輩

oak0723-1

回復 13# Andy2483


    千萬別叫我前輩,你真是高手
謝謝你
解決了
感恩

Andy2483

謝謝論壇,謝謝各位前輩
複習的心得註解如下,請各位前輩指教

Option Explicit
Sub TEST()
Dim Arr, i%, K%, xS As Worksheet, xB As Workbook, Ph$, T1$, T2$
'↑宣告變數:Arr是通用型變數,(i,K)是短整數,(Ph,T1,T2)是字串變數,xS是工作表變數
'xB是活頁簿變數
Application.ScreenUpdating = False
'↑令螢幕不隨著程序執行結果做變化
Set xB = ThisWorkbook: Ph = xB.Path & "\"
'↑令xB這活頁簿變數是 本檔
'令Ph這字串變數是本檔所在路徑連接"\"所組成的字串
Arr = Range([順序!E2], [順序!C65536].End(3))
'↑令Arr這通用型變數是 二維陣列,以"順序"表[E2]到C欄最後有內容儲存格,
'以這範圍儲存格值帶入
Sheets("集中").Cells.Clear
'↑令"集中"工作表全部儲存格清除內容
For i = 1 To UBound(Arr)
'↑設順迴圈!令i從1到 Arr陣列縱向最大索引列號
   T1 = Arr(i, 1) & ".xlsx": T2 = Arr(i, 2)
   '↑令T1這字串變數是 i迴圈列第1欄Arr陣列值連接".xlsx"組成的字串
   '令T2這字串變數是 i迴圈列第2欄Arr陣列值字串
   On Error Resume Next
   '↑令程序不偵錯
   Set xS = Workbooks(T1).Sheets(T2)
   '↑令xS這工作表變數是 名為(T1變數)活頁簿裡,名為(T2變數)的工作表
   If Err.Number <> 0 Then
   '↑如果傳回或設定指定錯誤的數值不是 0?
   https://learn.microsoft.com/zh-t ... ic-for-applications
      Set xS = Workbooks.Open(Ph & T1).Sheets(T2)
      '↑令XS變數是開啟Ph變數路徑下名為T1變數活頁簿裡,名為T2變數工作表
      K = 1
      '↑令K這短整數變數是 1
   End If
   On Error GoTo 0
   '↑令程序恢復偵錯
   If xS Is Nothing Then
   '↑如果xS變數不是物件?
      MsgBox T1 & " 活頁簿, " & T2 & " 工作表不存在!結束執行": Exit Sub
      '↑令跳出提視窗~~~,結束程序執行
   End If
   xS.[A:I].Copy xB.Sheets("集中").Cells(1, Arr(i, 3))
   '↑令xS變數的[A:I]儲存格複製到 xB活頁簿(本檔)"集中"工作表的第1列(指定欄)儲存格
   '指定欄:i迴圈列第3欄Arr陣列值
   If K = 1 Then xS.Parent.Close 0: K = 0
   '↑如果K變數是1?(代表xS工作表的活頁簿是執行程序中開啟的),
   'True就令其關閉,令K變數歸零
   Set xS = Nothing
   '↑令xS變數釋放
Next
Set xB = Nothing: Erase Arr
'↑令釋放變數
End Sub