簡體   English   中英

Excel-打開工作簿的名稱

[英]Excel - Open Workbooks given names

我有下面的代碼。

非常簡單,它要求用戶選擇多個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

這是一個需要微調的框架,但是您可以了解一下:

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

盡量不要在沒有絕對需要的情況下使用ActiveSheetActiveWorkbook 請改用ThisWorkbook ,專用的Workbook對象,並使用WorkbookWorkbook.Sheets("Name")Workbook.Sheets(index)命名。

另外,也可以禁用錯誤檢查而不是禁用錯誤檢查,如果文件丟失,則失敗。

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM