Страницы: 1
RSS
Перенос столбцов из текстового файла в фаил xls
 
Здравствуйте! Подскажите пожалуйста как вытащить из файла TXT столбцы со значениями (нужен столбец 8; 10; 13) в фаил xls.
 
Копируем это все в эксель, жмем Данные-Текст_по_столбцам, выбираем разделитель пробел. Затем ненужные столбцы удалите, нужные оставите.
 
А проблема в чем? Вот я макрорекордером записал открытие:  
Sub Макрос1()  
   Workbooks.OpenText Filename:="I:\Dokument\post_268737.txt", Origin:=866, _  
       StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 9), Array(6, _  
       9), Array(12, 9), Array(15, 9), Array(21, 9), Array(29, 9), Array(39, 9), Array(48, 1), _  
       Array(65, 9), Array(83, 1), Array(90, 9), Array(97, 9), Array(104, 1), Array(113, 9), Array _  
       (126, 9), Array(140, 9)), TrailingMinusNumbers:=True  
End Sub
Я сам - дурнее всякого примера! ...
 
{quote}{login=}{date=18.10.2011 03:56}{thema=}{post}Копируем это все в эксель, жмем Данные-Текст_по_столбцам, выбираем разделитель пробел. Затем ненужные столбцы удалите, нужные оставите.{/post}{/quote}Аногним, зачем усложнять? Просто открываем тхт файл и указываем нужные столбцы и кодировку.
Я сам - дурнее всякого примера! ...
 
угу, прямо в Excel нажимаем - Файл - Открыть... - указываем на наш текстовый файл и нажимаем кнопку Открыть. А дальше в появившемся окне выбираем нужные параметры
 
Спасибо помогло. Но получилась большая таблица в которой есть пробелы в виде окончания табличных данных, затем какой то текст и начало следующей таблицы. Как мне после определенного значения (3 ‹Ёбв) первой строке при окончании очередной таблицы  удалять 8 строк до начала новой таблицы? Попробовал вручную долго. Может подскажите формулу?
 
Может пример выложите? И еще - формулы не умеют удалять строки, толко макросы.
Я сам - дурнее всякого примера! ...
 
Можно так (возможно ещё с типами данных похимичить нужно):  
 
Sub ImportTXT()  
 
Dim f, strText, arr, a()  
Dim i As Long, lCount As Long  
 
Set f = CreateObject("Scripting.FileSystemObject").OpenTextFile("C:\tmp\post_268737.txt", 1)  
strText = f.ReadAll  
f.Close  
Set f = Nothing  
 
arr = Split(strText, Chr(10))  
strText = Empty  
 
lCount = UBound(arr)  
ReDim a(1 To lCount + 1, 1 To 3)  
 
'(нужен столбец 8; 10; 13)  
For i = 0 To lCount  
a(i + 1, 1) = Mid(arr(i), 50, 16)  
a(i + 1, 2) = Trim(Mid(arr(i), 85, 6))  
a(i + 1, 3) = Trim(Mid(arr(i), 106, 6))  
Next  
Erase arr  
 
 
[a1].Resize(UBound(a, 1), UBound(a, 2)).Value = a 'выгружаем результат
 
End Sub
 
Вот что получилось...  
Надо просто убрать пробелы между таблицей. Я начал убирать правда с пробелами, но в ручную это не реально, так как там разрыв в 500 страниц. Нужно просто одну целостную табличную часть без разрывов. Помогите если это можно сделать макросом.  
<EM><STRONG>Файл удален</STRONG> - велик размер - [<STRONG>МОДЕРАТОРЫ</STRONG>]</EM>
 
Прочитайте правила и выложите файл НОРМАЛЬНОГО размера.
Я сам - дурнее всякого примера! ...
 
Уменьшил фаил.
 
Sub www()  
   With ActiveSheet.UsedRange.Columns(2)  
       Union(.SpecialCells(2, 2), .SpecialCells(4)).EntireRow.Delete  
   End With  
End Sub
Я сам - дурнее всякого примера! ...
 
В мой вариант можно проверку встроить:  
For i = 0 To lCount  
If IsNumeric(Mid(arr(i), 50, 5)) Then  
a(i + 1, 1) = Mid(arr(i), 50, 16)  
a(i + 1, 2) = Trim(Mid(arr(i), 85, 6))  
a(i + 1, 3) = Trim(Mid(arr(i), 106, 6))  
End If  
Next
 
Спасибо что помогли!!!!! Единственное чего не хватает это убрать "-" тире в первом столбце между числами. И все я счастлив)))) Это последняя просьба.
 
ctrl+H
Я сам - дурнее всякого примера! ...
 
В моём варианте есть пара способов - или в массив брать данные из трёх мест строки, или потом в массиве через replace заменить что нужно.  
Но можно и заменять уже на листе в выгруженном.
 
Мне бы просто прописать в макросе это.
 
Я пытаюсь соединить 2 макроса которые вы мне написали и даже это у меня не очень получается. Уважаемые профессионалы если вас не затруднит можно выразить это одним текстом?
 
Одним макросом
 
Sub www()  
   Dim s$  
   Workbooks.OpenText Filename:="I:\Dokument\post_268737.txt", Origin:=866, _  
   StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 9), Array(6, _  
   9), Array(12, 9), Array(15, 9), Array(21, 9), Array(29, 9), Array(39, 9), Array(48, 1), _  
   Array(65, 9), Array(83, 1), Array(90, 9), Array(97, 9), Array(104, 1), Array(113, 9), Array _  
   (126, 9), Array(140, 9)), TrailingMinusNumbers:=True  
   With ActiveSheet.UsedRange.Columns(2)  
       Union(.SpecialCells(2, 2), .SpecialCells(4)).EntireRow.Delete  
   End With  
   s = ActiveSheet.UsedRange.Columns(1).Address  
   Range(s).Value = Evaluate("""'""&" & s)  
   [A:A].Replace What:="-", Replacement:="", LookAt:=xlPart
End Sub
Я сам - дурнее всякого примера! ...
 
Почему то он нстанавливается на этой строке  
Union(.SpecialCells(2, 2), .SpecialCells(4)).EntireRow.Delete
 
#ЗНАЧ! 75 75  
Вот что получается при обработке макроса.
 
Попробуйте мой вариант.  
 
Option Explicit  
 
Sub ImportTXT()  
 
Dim f, strText, arr, a()  
Dim i As Long, ii As Long, lCount As Long  
 
Set f = CreateObject("Scripting.FileSystemObject").OpenTextFile("C:\tmp\post_268737.txt", 1)  
strText = f.ReadAll  
f.Close  
Set f = Nothing  
 
arr = Split(strText, Chr(10))  
strText = Empty  
 
lCount = UBound(arr)  
ReDim a(1 To lCount + 1, 1 To 3)  
 
'(нужен столбец 8; 10; 13)  
For i = 0 To lCount  
If IsNumeric(Mid(arr(i), 50, 5)) Then  
ii = ii + 1  
a(ii, 1) = Mid(arr(i), 50, 16)  
a(ii, 1) = Replace(a(ii, 1), "-", "")  
a(ii, 2) = Trim(Mid(arr(i), 85, 6))  
a(ii, 3) = Trim(Mid(arr(i), 106, 6))  
End If  
Next  
 
Erase arr  
 
Columns(1).NumberFormat = "0"  
[a1].Resize(ii, UBound(a, 2)).Value = a 'выгружаем результат
Columns(1).AutoFit  
End Sub
 
Hugo БОЛЬШОЕ СПАСИБО!!!!! все работает!!!!
Страницы: 1
Читают тему
Наверх