Question

我正在尝试修复当前的代码，以允许一次打开多个excel工作簿，而不是一次打开一个。目前我的代码一次运行一个，我打开工作簿，复制数据，粘贴到宏工作簿，然后关闭外部工作簿。

当前代码：

php.ini

此外，此代码从excel文件名中获取数字，例如。 Sub Intro() Dim fd As FileDialog Dim wkbCrntWorkBook As Workbook Dim wkbSourceBook As Workbook Dim fNameAndPath As Variant Set wkbCrntWorkBook = ActiveWorkbook fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel 2007, *.xls; _ *.xlsx; *.xlsm; *.xlsa", Title:="Select File To Import") If fNameAndPath = False Then Exit Sub Call ReadDataFromSourceFile(fNameAndPath) End Sub Sub ReadDataFromSourceFile(filePath As Variant) Application.ScreenUpdating = False Dim n As Double Dim wksNew As Excel.Worksheet Dim src As Workbook Set src = Workbooks.Open(filePath, False, False) On Error GoTo CloseIt Dim srcRng As Range With src.Worksheets("Sheet1") Set srcRng = .Range(.Range("A1"), .Range("A1").End(xlDown).End(xlToRight)) End With With ThisWorkbook Set wksNew = .Worksheets.Add(After:=.Worksheets(.Sheets.Count)) n = .Sheets.Count .Worksheets(n).Range("A1").Resize(srcRng.Rows.Count, srcRng.Columns.Count).Value = srcRng.Value End With Dim regEx As New RegExp Dim GetNum As String Dim strPattern As String Dim strInput As String Dim strReplace As String Dim strOutput As String Dim match As Object strPattern = "^\d{0,9}\B|\b\d{0,9}(?=\s*\.)" If strPattern <> "" Then strInput = src.Name With regEx .Global = True .MultiLine = True .IgnoreCase = False .Pattern = strPattern End With If regEx.test(strInput) Then Set match = regEx.Execute(strInput) GetNum = match.Item(0) ThisWorkbook.Worksheets(n).Name = GetNum Else GetNum = "" End If End If src.Close False Set src = Nothing Exit Sub CloseIt: src.Close False Set src = Nothing Application.DisplayAlerts = False ThisWorkbook.Worksheets(n).Delete Application.DisplayAlerts = True MsgBox "ERROR!! You already entered this file" End Sub，因此它抓取日期（010117）并将新工作表命名为日期。

但是，我更关心的是做类似下面的代码，以便更容易上传文件。这是我在site

找到的

测试代码：

"010117Siemens Hot - Cold Report.xls"

总之，我很好奇是否有办法组合这些方法并创建一个打开外部Excel工作簿的子程序，复制数据，将其粘贴到宏工作簿中的新工作表中，然后关闭外部工作簿。提前致谢

我将目前的内容编辑为我一直在努力尝试解决的问题，但我遇到了Sub OpenSeveralFiles() Dim fd As FileDialog Dim FileChosen As Integer Dim FileName As String Dim i As Integer Set fd = Application.FileDialog(msoFileDialogFilePicker) fd.InitialFileName = "Libraries\Documents" fd.InitialView = msoFileDialogViewList fd.AllowMultiSelect = True FileChosen = fd.Show If FileChosen = -1 Then For i = 1 To fd.SelectedItems.Count Workbooks.Open fd.SelectedItems(i) Call ReadDataFromSourceFile(FileChosen) Next i End If End Sub Private Sub ReadDataFromSourceFile(filePath As Variant) Application.ScreenUpdating = False Dim n As Double Dim wksNew As Excel.Worksheet Dim src As Workbook Set src = Workbooks.Open(filePath, False, False) On Error GoTo CloseIt Dim srcRng As Range With src.Worksheets("Sheet1") Set srcRng = .Range(.Range("A1"), .Range("A1").End(xlDown).End(xlToRight)) End With With ThisWorkbook Set wksNew = .Worksheets.Add(After:=.Worksheets(.Sheets.Count)) n = .Sheets.Count .Worksheets(n).Range("A1").Resize(srcRng.Rows.Count, srcRng.Columns.Count).Value = srcRng.Value End With Dim regEx As New RegExp Dim GetNum As String Dim strPattern As String Dim strInput As String Dim strReplace As String Dim strOutput As String Dim match As Object strPattern = "^\d{0,9}\B|\b\d{0,9}(?=\s*\.)" If strPattern <> "" Then strInput = src.Name With regEx .Global = True .MultiLine = True .IgnoreCase = False .Pattern = strPattern End With If regEx.test(strInput) Then Set match = regEx.Execute(strInput) GetNum = match.Item(0) ThisWorkbook.Worksheets(n).Name = GetNum Else GetNum = "" End If End If src.Close False Set src = Nothing Exit Sub CloseIt: src.Close False Set src = Nothing Application.DisplayAlerts = False ThisWorkbook.Worksheets(n).Delete Application.DisplayAlerts = True MsgBox "ERROR!! You already entered this file" End Sub的问题。因为它未定义？

Answer 1

为了一次打开多个文件，循环并在每个文件上执行代码，然后关闭它，尝试下面的OUTLINED：

Sub OpenSeveralFiles()

Dim fd As FileDialog
Dim FileChosen As Integer
Dim FileName As String
Dim tempWB As Workbook
Dim i As Integer

Set fd = Application.FileDialog(msoFileDialogFilePicker)

fd.InitialFileName = "Libraries\Documents"
fd.InitialView = msoFileDialogViewList
fd.AllowMultiSelect = True

FileChosen = fd.Show
If FileChosen = -1 Then
    For i = 1 To fd.SelectedItems.Count
        Set tempWB = Workbooks.Open(fd.SelectedItems(i))
        Call ReadDataFromSourceFile(tempWB)
    Next i
End If
End Sub

Private Sub ReadDataFromSourceFile(src As Workbook)

Application.ScreenUpdating = False

' do your stuff   

End Sub

这应该是回答您一次打开多个文件并对每个文件执行某些操作的原始问题的开始。您当前尝试的方式尝试两次打开每个文件但我不认为您实际上是将字符串传递给ReadDataFromSourceFile子。这样您就可以传递对工作簿的引用，只需删除打开文件的位置并定义src即可。您的RegExp问题在我看来就像是一个单独的问题/问题。

打开多个excel文件，复制，粘贴，关闭

1 个答案: