如何在Excel中快速批量导入多个csv / text / xml文件？

Sub LoadPipeDelimitedFiles() UpdatebyKutoolsforExcel20151214 Dim xStrPath As String Dim xFileDialog As FileDialog Dim xFile As String Dim xCount As Long On Error GoTo ErrHandler Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker) xFileDialog.AllowMultiSelect = False xFileDialog.Title = "Select a folder [Kutools for Excel]" If xFileDialog.Show = -1 Then xStrPath = xFileDialog.SelectedItems(1) End If If xStrPath = "" Then Exit Sub Application.ScreenUpdating = False xFile = Dir(xStrPath & "\*.txt") Do While xFile <> "" xCount = xCount + 1 Sheets(xCount).Select With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _ & xStrPath & "\" & xFile, Destination:=Range("A1")) .Name = "a" & xCount .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassWord = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 437 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False .TextFileOtherDelimiter = "|" .TextFileColumnDataTypes = Array(1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False xFile = Dir End With Loop Application.ScreenUpdating = True Exit Sub ErrHandler: MsgBox "no files txt", , "Kutools for Excel" End Sub

轻松地将多个工作表/工作簿合并为一个工作表或工作簿

在Excel中，将多个工作表或工作簿组合成一个工作表或工作簿可能很麻烦，但是使用 结合 功能 Kutools for Excel，您可以将数十个工作表/工作簿合并为一个工作表或工作簿，也可以通过几次单击将工作表合并为一个。  点击查看全功能 30 天免费试用！ Kutools for Excel：超过300个方便的Excel插件，免费试用，没有限制 30 天。

Sub ImportCSVsWithReference() UpdatebyKutoolsforExcel20151214 Dim xSht As Worksheet Dim xWb As Workbook Dim xStrPath As String Dim xFileDialog As FileDialog Dim xFile As String On Error GoTo ErrHandler Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker) xFileDialog.AllowMultiSelect = False xFileDialog.Title = "Select a folder [Kutools for Excel]" If xFileDialog.Show = -1 Then xStrPath = xFileDialog.SelectedItems(1) End If If xStrPath = "" Then Exit Sub Set xSht = ThisWorkbook.ActiveSheet If MsgBox("Clear the existing sheet before importing?", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear Application.ScreenUpdating = False xFile = Dir(xStrPath & "\" & "*.csv") Do While xFile <> "" Set xWb = Workbooks.Open(xStrPath & "\" & xFile) Columns(1).Insert xlShiftToRight Columns(1).SpecialCells(xlBlanks).Value = ActiveSheet.Name ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1) xWb.Close False xFile = Dir Loop Application.ScreenUpdating = True Exit Sub ErrHandler: MsgBox "no files csv", , "Kutools for Excel" End Sub

Sub ImportCSVsWithReferenceI() UpdatebyKutoolsforExcel20151214 Dim xSht As Worksheet Dim xWb As Workbook Dim xStrPath As String Dim xFileDialog As FileDialog Dim xFile As String Dim xCount As Long On Error GoTo ErrHandler Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker) xFileDialog.AllowMultiSelect = False xFileDialog.Title = "Select a folder [Kutools for Excel]" If xFileDialog.Show = -1 Then xStrPath = xFileDialog.SelectedItems(1) End If If xStrPath = "" Then Exit Sub Set xSht = ThisWorkbook.ActiveSheet If MsgBox("Clear the existing sheet before importing?", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear xCount = 1 Else xCount = xSht.Cells(3, Columns.Count).End(xlToLeft).Column + 1 End If Application.ScreenUpdating = False xFile = Dir(xStrPath & "\" & "*.csv") Do While xFile <> "" Set xWb = Workbooks.Open(xStrPath & "\" & xFile) Rows(1).Insert xlShiftDown Range("A1") = ActiveSheet.Name ActiveSheet.UsedRange.Copy xSht.Cells(1, xCount) xWb.Close False xFile = Dir xCount = xSht.Cells(3, Columns.Count).End(xlToLeft).Column + 1 Loop Application.ScreenUpdating = True Exit Sub ErrHandler: MsgBox "no files csv", , "Kutools for Excel" End Sub

Sub From_XML_To_XL() UpdatebyKutoolsforExcel20151214 Dim xWb As Workbook Dim xSWb As Workbook Dim xStrPath As String Dim xFileDialog As FileDialog Dim xFile As String Dim xCount As Long On Error GoTo ErrHandler Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker) xFileDialog.AllowMultiSelect = False xFileDialog.Title = "Select a folder [Kutools for Excel]" If xFileDialog.Show = -1 Then xStrPath = xFileDialog.SelectedItems(1) End If If xStrPath = "" Then Exit Sub Application.ScreenUpdating = False Set xSWb = ThisWorkbook xCount = 1 xFile = Dir(xStrPath & "\*.xml") Do While xFile <> "" Set xWb = Workbooks.OpenXML(xStrPath & "\" & xFile) xWb.Sheets(1).UsedRange.Copy xSWb.Sheets(1).Cells(xCount, 1) xWb.Close False xCount = xSWb.Sheets(1).UsedRange.Rows.Count + 2 xFile = Dir() Loop Application.ScreenUpdating = True xSWb.Save Exit Sub ErrHandler: MsgBox "no files xml", , "Kutools for Excel" End Sub

免费下载免费全功能 30- 天

最佳办公生产力工具

在Word，Excel，PowerPoint中启用选项卡式编辑和阅读，发布者，Access，Visio和Project。 在同一窗口的新选项卡中而不是在新窗口中打开并创建多个文档。 每天将您的工作效率提高50％，并减少数百次鼠标单击！