Страница 1 из 1
Подскажите пжлста!!
Добавлено: 26 ноя 2008, 12:02
Vaseninbox
Всем доброго времени суток!
Помогите, плиз, разобраться с очередной проблемой.
Есть файл, сохранённый в режиме .txt (блокнот) в папке “Test” на рабочем столе. В нём три столбца и в каждом по 10 строк:
Например:
[HTML]18:00:53 Имя1 15663
18:00:55 Имя2 35615
18:00:59 Имя3 96451
И т.д. до десятой строки...[/HTML]
Как открыть (прочитать) этот файл макросом Excel и скопировать на «Лист1» «Книги1.xls» эти три столбца соответственно в A1:A10-для первого, B1:B10-для второго и в C1:C10-для третьего столбца из документа .txt??
Re: Подскажите пжлста!!
Добавлено: 26 ноя 2008, 13:25
EducatedFool
Код: Выделить всё
Sub test()
Application.ScreenUpdating = False
Filename = "C:\Documents and Settings\Администратор\Рабочий стол\Текст.txt" ' укажите здесь полный путь к своему текстовому файлу
Workbooks.OpenText Filename:=Filename, DataType:=xlDelimited, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, Comma:=False, Space:=True
If ActiveWorkbook.FullName = Filename Then ' файл открылся
ActiveSheet.UsedRange.Copy ThisWorkbook.Worksheets(1).[a1] ' копируем содержимое текстового файла в этот файл
ActiveWorkbook.Close False ' закрываем текстовый файл без сохранения
End If
End Sub
Re: Подскажите пжлста!!
Добавлено: 26 ноя 2008, 13:52
EducatedFool
А такой код будет работать ещё быстрее:
Код: Выделить всё
Sub test2()
On Error Resume Next
Filename = "C:\Documents and Settings\Администратор\Рабочий стол\Текст.txt" ' укажите здесь полный путь к своему текстовому файлу
Dim arr() ', fso As FileSystemObject, ts As TextStream
Set fso = CreateObject("scripting.filesystemobject"): Set ts = fso.OpenTextFile(Filename, 1)
If ts Is Nothing Then Exit Sub
content = ts.ReadAll: ts.Close
While InStr(1, content, " ") > 0: content = Replace(content, " ", " "): Wend
a = Split(content, vbCrLf): If Not IsArray(a) Then Exit Sub
b = Split(a(1), " "): If Not IsArray(b) Then Exit Sub
ReDim arr(0 To UBound(a), 0 To UBound(b))
For i = 0 To UBound(a): b = Split(a(i), " "): For j = 0 To UBound(b): arr(i, j) = b(j): Next: Next
ThisWorkbook.Worksheets(1).Range("a1").Resize(UBound(a) + 1, UBound(b) + 1).Value = arr
End Sub
Re: Подскажите пжлста!!
Добавлено: 26 ноя 2008, 22:24
Aent
А ещё быстрее будет не использовать FSO а обойтись средствами VBA, который сам успешно умеет читать файлы
Более того, если колонки фиксированы, то можно не заморачиваться со Split, а использовать
старый добрый Mid$
Я как то таким манером загружал в 2007 Excel логи телефонной станции.
900000 записейзагрузилось за несколько секунд
Для 10 строк всё это конечно никакого значения не имеет ...
Re: Подскажите пжлста!!
Добавлено: 27 ноя 2008, 15:12
Naeel Maqsudov
ну вы даете, господа! Браво.
Я вчера написал другой вариант. Закину... Не пропадать же добру
Я воспользовался методом TextToColumn (который стандартно вызывается из меню Данные\Текст по столбцам)
Код: Выделить всё
Sub test()
Call Read_N_Split(Range("B3"), "C:\somefile.txt")
End Sub
Sub Read_N_Split(base As Range, file As String)
Dim i As Integer, FN As Integer
FN = FreeFile
Open file For Input As #FN
i = -1
While Not EOF(FN)
Input #FN, S
If Trim(S) > "" Then
i = i + 1
base.Offset(i, 0).Value = S
End If
Wend
Close #FN
base.Range(Cells(1, 1), Cells(i + 1, 1)).TextToColumns Destination:=base, _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, Space:=True, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1))
End Sub