Всем доброго времени суток!
Помогите, плиз, разобраться с очередной проблемой.
Есть файл, сохранённый в режиме .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??
Подскажите пжлста!!
Модератор: Naeel Maqsudov
-
- Сообщения: 34
- Зарегистрирован: 05 сен 2008, 15:11
- Контактная информация:
- EducatedFool
- Сообщения: 197
- Зарегистрирован: 06 апр 2008, 14:03
- Откуда: Россия, Урал
- Контактная информация:
Код: Выделить всё
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
- EducatedFool
- Сообщения: 197
- Зарегистрирован: 06 апр 2008, 14:03
- Откуда: Россия, Урал
- Контактная информация:
А такой код будет работать ещё быстрее:
Код: Выделить всё
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
- Aent
- Сообщения: 1129
- Зарегистрирован: 01 окт 2006, 14:52
- Откуда: Saratov,Russia
- Контактная информация:
А ещё быстрее будет не использовать FSO а обойтись средствами VBA, который сам успешно умеет читать файлы 
Более того, если колонки фиксированы, то можно не заморачиваться со Split, а использовать
старый добрый Mid$
Я как то таким манером загружал в 2007 Excel логи телефонной станции.
900000 записейзагрузилось за несколько секунд

Для 10 строк всё это конечно никакого значения не имеет ...

Более того, если колонки фиксированы, то можно не заморачиваться со Split, а использовать
старый добрый Mid$

Я как то таким манером загружал в 2007 Excel логи телефонной станции.
900000 записейзагрузилось за несколько секунд


Для 10 строк всё это конечно никакого значения не имеет ...
Андрей Энтелис,
aentelis.livejournal.com
aentelis.livejournal.com
- Naeel Maqsudov
- Сообщения: 2570
- Зарегистрирован: 20 фев 2004, 19:17
- Откуда: Moscow, Russia
- Контактная информация:

Я вчера написал другой вариант. Закину... Не пропадать же добру

Я воспользовался методом 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