我有下面的代码。
非常简单,它要求用户选择多个 Excel 工作簿,然后将这些工作簿中的数据复制并粘贴到当前工作簿中。
1.
我想添加功能,而不是用户选择 Excel 工作簿。将选择 Excel 工作簿,因为它们的名称列在当前的 Excel 工作表上。
例如 - 选择名称在 A1:A5 中列出的指定文件夹中的 excel 工作簿。
例如,如果工作簿名称 = 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
最佳答案
这是一个需要微调的框架,但您可以理解:
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)
反而。或者,如果文件丢失,您可以执行此操作并失败,而不是禁用错误检查。
关于vba - Excel - 打开给定名称的工作簿,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/42070682/