Excel - 打開工作簿名稱

Question

我有以下代碼。

非常簡單，它要求用戶選擇多個Excel工作簿，然後將數據從這些工作簿複製並粘貼到當前工作簿。

1. 我想添加功能，而不是用戶選擇Excel工作簿。 Excel工作簿將被選中，因爲他們的名字被列在當前的Excel表格中。

例如 - 選擇名稱在A1：A5中列出的指定文件夾中的Excel工作簿。

1. 我想在將數據複製到當前工作簿之前對數據執行自動處理。

例如，如果工作簿名稱= 100.xlsx然後通過15

乘以選擇參閱我當前的代碼

Sub SUM_BalanceSheet() 

Application.ScreenUpdating = False 

'FileNames is array of file names, file is for loop, wb is for the open file within loop 
'PasteSheet is the sheet where we'll paste all this information 
'lastCol will find the last column of PasteSheet, where we want to paste our values 
Dim FileNames 
Dim file 
Dim wb As Workbook 
Dim PasteSheet As Worksheet 
Dim lastCol As Long 

Set PasteSheet = ActiveSheet 
lastCol = PasteSheet.Cells(1, Columns.Count).End(xlToLeft).Column 

'Build the array of FileNames to pull data from 
FileNames = Application.GetOpenFilename(filefilter:="Excel Files (*.xlsx), *.xlsx", MultiSelect:=True) 
'If user clicks cancel, exit sub rather than throw an error 
If Not IsArray(FileNames) Then Exit Sub 

'Loop through selected files, put file name in row 1, paste P18:P22 as values 
'below each file's filename. Paste in successive columns 
For Each file In FileNames 
    Set wb = Workbooks.Open(file, UpdateLinks:=0) 
    PasteSheet.Cells(1, lastCol + 1) = wb.Name 
    wb.Sheets("Page 1").Range("L14:L98").Copy 
    PasteSheet.Cells(2, lastCol + 1).PasteSpecial Paste:=xlPasteValues 
    wb.Close SaveChanges:=False 
    lastCol = lastCol + 1 
Next 

'If it was a blank sheet then data will start pasting in column B, and we don't 
'want a blank column A, so delete it if it's blank 
If Cells(1, 1) = "" Then Cells(1, 1).EntireColumn.Delete shift:=xlLeft 

Application.CutCopyMode = False 
Application.ScreenUpdating = True 

End Sub 

Answer 1

這是需要微調的框架，但你可以得到這個想法：

Dim i&, wbName$ 
Dim rng As Excel.Range 
Dim wb, wb1 As Excel.Workbook 

Set wb = Application.ThisWorkbook 
Set rng = wb.Sheets("Sheet1").Range("A1") 
For i = 0 To 14 
    wbName = CStr(rng.Offset(i, 0).Value) 
    On Error Resume Next 'Disable error handling. We will check whether wb is nothing later 
    wb1 = Application.Workbooks.Open(wbName, False) 
    On Error GoTo ErrorHandler 
    If Not IsNothing(wb1) Then 
     'Copy-paste here 
     If wb1.Name = "100" Then 'any condition(s) 
      'Multiply, divide, or whatever 
     End If 
    End If 
Next 


ErrorHandler: 
    MsgBox "Error " & Err.Description 
    'Add additional error handling 

儘量不要使用ActiveSheet和ActiveWorkbook沒有絕對需要。代替使用ThisWorkbook，專用Workbook對象，並命名爲Workbook.Sheets("Name")或Workbook.Sheets(index)。

或者，如果文件丟失，您可以執行此操作並失敗，而不是禁用錯誤檢查。