Допустим, у вас есть папка на жестком диске, содержащая тридцать текстовых файлов, и вы хотите импортировать их все в книгу Excel. Вы хотите, чтобы каждый текстовый файл помещался на отдельном листе в книге, чтобы у вас было всего тридцать листов.

Один из способов сделать это — вручную добавить желаемые рабочие листы, а затем индивидуально импортировать каждый из текстовых файлов. Как вы понимаете, это быстро надоест. Гораздо лучшее решение — использовать макрос для импорта, например следующий.

Sub CombineTextFiles()

Dim FilesToOpen     Dim x As Integer     Dim wkbAll As Workbook     Dim wkbTemp As Workbook     Dim sDelimiter As String

On Error GoTo ErrHandler     Application.ScreenUpdating = False

sDelimiter = "|"



FilesToOpen = Application.GetOpenFilename _       (FileFilter:="Text Files (.txt), .txt", _       MultiSelect:=True, Title:="Text Files to Open")



If TypeName(FilesToOpen) = "Boolean" Then         MsgBox "No Files were selected"

GoTo ExitHandler     End If

x = 1     Set wkbTemp = Workbooks.Open(FileName:=FilesToOpen(x))

wkbTemp.Sheets(1).Copy     Set wkbAll = ActiveWorkbook     wkbTemp.Close (False)

wkbAll.Worksheets(x).Columns("A:A").TextToColumns _       Destination:=Range("A1"), DataType:=xlDelimited, _       TextQualifier:=xlDoubleQuote, _       ConsecutiveDelimiter:=False, _       Tab:=False, Semicolon:=False, _       Comma:=False, Space:=False, _       Other:=True, OtherChar:="|"

x = x + 1

While x <= UBound(FilesToOpen)

Set wkbTemp = Workbooks.Open(FileName:=FilesToOpen(x))

With wkbAll             wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)

.Worksheets(x).Columns("A:A").TextToColumns _               Destination:=Range("A1"), DataType:=xlDelimited, _               TextQualifier:=xlDoubleQuote, _               ConsecutiveDelimiter:=False, _               Tab:=False, Semicolon:=False, _               Comma:=False, Space:=False, _               Other:=True, OtherChar:=sDelimiter         End With         x = x + 1     Wend

ExitHandler:

Application.ScreenUpdating = True     Set wkbAll = Nothing     Set wkbTemp = Nothing     Exit Sub

ErrHandler:

MsgBox Err.Description     Resume ExitHandler End Sub

Этот макрос позволяет вам выбирать, какие файлы вы хотите импортировать, а затем помещает данные из этих файлов на отдельные рабочие листы в книге. Макрос предполагает, что импортируемые данные используют вертикальную черту (|) в качестве разделителя между полями.

Если вы знаете, что файлы, которые нужно импортировать, всегда находятся в определенной папке и что вы хотите импортировать все файлы в этой папке, вы можете немного упростить макрос. В следующем примере предполагается, что файлы находятся в папке c: \ temp \ load_excel, но вы можете изменить имя этой папки, просто изменив переменную fpath в коде макроса.

Sub LoadPipeDelimitedFiles()

Dim idx As Integer     Dim fpath As String     Dim fname As String

idx = 0     fpath = "c:\temp\load_excel\"

fname = Dir(fpath & "*.txt")

While (Len(fname) > 0)

idx = idx + 1         Sheets("Sheet" & idx).Select         With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _           & fpath & fname, Destination:=Range("A1"))

.Name = "a" & idx             .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             fname = Dir         End With     Wend End Sub

_Примечание: _

Если вы хотите узнать, как использовать макросы, описанные на этой странице (или на любой другой странице на сайтах ExcelTips), я подготовил специальную страницу, содержащую полезную информацию.

link: / excelribbon-ExcelTipsMacros [Щелкните здесь, чтобы открыть эту специальную страницу в новой вкладке браузера].

ExcelTips — ваш источник экономичного обучения Microsoft Excel.

Этот совет (10400) относится к Microsoft Excel 2007 и 2010. Вы можете найти версию этого совета для более старого интерфейса меню Excel здесь:

link: / excel-Importing_Multiple_Files_to_a_Single_Workbook [Импорт нескольких файлов в одну книгу].