Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 26.05.2020, 08:34   #1
Mkoty
Пользователь
 
Регистрация: 26.05.2020
Сообщений: 22
По умолчанию поиск в TXT по слову и перенос в Excel по столбцам через табуляцию

Добрый День.
Существует ТХТ в котором 10 столбцов разделенных символами табуляции.
Требуется:
Выбрать строки в которых найдено значение и вставить в Эксель.
но заносило по столбцам через табуляцию.
сделал, но по столбцам не заносит:

Код:
Sub test()     '
    strFilePath = "MyTestFile.txt"
    Call ImportFromTxt("\\Servbuh\e\Аналитика\Текст.txt", "*02805*")
End Sub
 
Sub ImportFromTxt(ByVal strFilePath As String, ByVal strLike As String)
  Const ForReading As Byte = 1
  
  Dim i As Long
  Dim fso As Object, tso As Object
  Dim strLine As String
  Dim x As Long: x = 1
 
  Set fso = CreateObject("Scripting.FileSystemObject")      '
  Set tso = fso.OpenTextFile(strFilePath, ForReading)
 
  i = 1
  Sheets("Лист2").Select
  Cells.Select
  Application.CutCopyMode = False
  Selection.ClearContents
  
  Do While Not tso.AtEndOfStream        '
        strLine = tso.ReadLine
        If strLine Like strLike Then
            Cells(x, 1).Value = strLine
            x = x + 1
        End If
    i = i + 1
  Loop
 
  tso.Close
  Set tso = Nothing
 
  Set fso = Nothing
End Sub
есть другой макрос заносит по столбцам, но все подряд.

Код:
Sub tt()
Dim a, i&, tmp
a = Split(CreateObject("Scripting.FileSystemObject").Getfile("\\Servbuh\e\Аналитика\Текст.txt").OpenasTextStream(1).readall, vbNewLine)
For i = 0 To UBound(a)
a(i) = Replace(a(i), """", "")
tmp = Split(a(i), vbTab)
Cells(i + 1, 1).Resize(1, UBound(tmp)) = tmp
Next
End Sub
скрестить их не могу
если не сложно помогите
Вложения
Тип файла: rar Текст.rar (225.5 Кб, 2 просмотров)
Mkoty вне форума Ответить с цитированием
Старый 26.05.2020, 08:47   #2
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Код:
Option Explicit

Sub test()     '
    Dim strFilePath As String
    strFilePath = Environ("USERPROFILE") & "\Desktop\Текст.txt"
    Call ImportFromTxt(strFilePath, "*02805*")
End Sub

Sub ImportFromTxt(ByVal strFilePath As String, ByVal strLike As String)
    Const ForReading As Byte = 1
    
    Dim i As Long
    Dim tmp
    Dim fso As Object, tso As Object
    Dim strLine As String
    Dim x As Long: x = 1
    
    Set fso = CreateObject("Scripting.FileSystemObject")      '
    Set tso = fso.OpenTextFile(strFilePath, ForReading)
    
    i = 1
    Sheets("Лист2").Select
    Cells.Select
    Application.CutCopyMode = False
    Selection.ClearContents
    
    Do While Not tso.AtEndOfStream        '
        strLine = tso.ReadLine
        If strLine Like strLike Then
            tmp = Split(strLine, vbTab)
            Cells(x, 1).Resize(1, UBound(tmp)) = tmp
            x = x + 1
        End If
        i = i + 1
    Loop
    
    tso.Close
    Set tso = Nothing
    
    Set fso = Nothing
End Sub
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 26.05.2020, 11:37   #3
Mkoty
Пользователь
 
Регистрация: 26.05.2020
Сообщений: 22
По умолчанию

Спасибо огромное.
Работает!

Только последний столбец не заносит

разобрался, после последнего значения в столбце поставил табуляцию и жизнь наладилась

Последний раз редактировалось Mkoty; 26.05.2020 в 11:53.
Mkoty вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Поиск по слову Tytyti Помощь студентам 0 25.03.2018 14:11
[C++] Структура поиска. нужен поиск где пишете названия товара либо начальные буквы или конец слова поисковике но у меня получается только поиск по начальному слову. Anam56 Помощь студентам 1 09.05.2017 22:24
Поиск в БД по слову из Memo Sony_boy БД в Delphi 8 23.01.2016 20:24
Поиск данных в Excel и перенос в шаблон Power Point meshkale Общие вопросы Delphi 2 23.04.2014 13:17
Поиск по Ключевому слову Applod Компоненты Delphi 0 22.11.2011 21:21