PDA

Показать полную графическую версию : Excel сбор данных с нескольких файлов


Streamnewal
14-05-2014, 06:39
Есть столбец данных однотипный в нескольких файлах, причем с расширением txt. Их около 100 штук.
Столбцы расположены в одном и том же месте. Нужно разместить их последовательно друг за другом в одном файле, как в примере.
Текстовые файлы нормально открываются. с форматированием, только при использовании мастера текстов.

Iska
14-05-2014, 23:20
На WSH, пробуйте:
Option Explicit

Dim strSourceFolder

Dim objFile
Dim arrContent

Dim objExcel
Dim objWorkbook
Dim objWorksheet
Dim objRange
Dim i

If WScript.Arguments.Count = 1 Then
strSourceFolder = WScript.Arguments.Item(0)

With WScript.CreateObject("Scripting.FileSystemObject")
If .FolderExists(strSourceFolder) Then
Set objExcel = Nothing

For Each objFile In .GetFolder(strSourceFolder).Files
If LCase(.GetExtensionName(objFile.Name)) = "txt" Then
If objExcel Is Nothing Then
Set objExcel = WScript.CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Add()
Set objWorksheet = objWorkbook.Worksheets.Item(1)
Set objRange = objWorksheet.Range("C3")
End If


With .OpenTextFile(objFile.Path)
arrContent = Split(.ReadAll(), vbCrLf)
.Close
End With

objRange.Value = .GetBaseName(objFile.Name)
objRange.Font.Bold = True

For i= LBound(arrContent) To UBound(arrContent) - 1
objRange.Offset(i + 1, 0).Value = Split(arrContent(i), vbTab)(1)
Next

Set objRange = objRange.Offset(0, 1)
End If
Next

If Not objExcel Is Nothing Then
Set objRange = Nothing
Set objWorksheet = Nothing

objWorkbook.SaveAs .BuildPath(strSourceFolder, "Result.xls")
Set objWorkbook = Nothing

objExcel.Quit
Set objExcel = Nothing
End If
Else
WScript.Echo "Can't find source folder [" & strSourceFolder & "]."
WScript.Quit 2
End If
End With
Else
WScript.Echo "Usage: cscript.exe //nologo " & WScript.ScriptName & " <Source folder>"
WScript.Quit 1
End If

WScript.Quit 0

Можно просто перетащить папку с искомыми файлами на скрипт.

Streamnewal
15-05-2014, 05:39
Спасибо. Буду пробовать.




© OSzone.net 2001-2012