Страницы: 1
RSS
Извлечение конкретных значений из текстовых файлов в Excel
 
Здравствуйте!
Есть файл u8_u5_vba_2.txt.out (в общем-то их несколько чуть разных). В нём есть строка  " k-eff is   0.955331" (без кавычек). Необходимо, чтобы макрос анализировал файл, находил в нём нужную строку, брал из неё значение (число 0.955331) и помещал его в ячейку.
Результатом ковыряния в течении нескольких дней стало несколько нерабочих вариантов «кодов», один предоставлен на обозрение. Дальнейший поиск ни к чему не привёл в силу моего скудоумия и накопившейся усталости - просто не могу сообразить в чём дело. Есть крайний вариант сначала импортировать весь текстовый файл в Excel и далее обрабатывать уже импортированный текст, но этот вариант мне не нравится, так как файлов много и сами они большие (прикреплённый файл урезан).
Кому не сложно, внесите правки, укажите на ошибку или направьте куда следует.
Код
Dim strLine As String       'Одна строка файла
Dim strСurСhar As String    'Анализируемый символ строки файла
Dim strValue As String      'Значение для записи в ячейку
Dim lngRow As Long          'Номер текущей строки
Dim intCol As Integer       'Номер текущего столбца
Dim i As Integer
Dim Result As Boolean

Open "L:\vba85\u8_u5_vba_2.txt.out" For Input As #2

Do Until EOF(2) 'Result = True 'По-хорошему до первого необходимого результата
    Line Input #2, strLine
    For i = 1 To Len(strLine)
        strCurChar = Mid(strLine, i, 1)
        strValue = strValue + strCurChar
    Next i
    Result = strValue Like " k-eff is *"
    If Result = True Then
        Range("C167").Activate
        ActiveCell.Offset(lngRow, intCol) = Mid(strValue, 13, 8)  
    Else
        'MsgBox "XYU"
    End If 
    intCol = 0
    lngRow = lngRow + 1
Loop
Close #2
За корявость можете пинать что есть сил и сколько хотите, главное - подскажите.
Заранее благодарю.
 
Для начала поменяйте в профиле отображаемое имя - сейчас оно с нарушением Правил.
 
Вы уверены, что в начале строки есть пробел? Не пробовали при варианте?
Код
strValue Like "k-eff is *"
 
Файла не вижу.
На первый взгляд скрипт можно укоротить, если воспользоваться регулярными выражениями.
С уважением,
Федор/Все_просто
 
В начале строки пробел есть.
Что-то файл в первый раз не прикрепился.
 
Вот так у меня сработало (только привязку я для простоты ставил к активной ячейке)
Код
Sub tt()
Dim strLine As String       'Одна строка файла
Dim strСurСhar As String    'Анализируемый символ строки файла
Dim strValue As String      'Значение для записи в ячейку
Dim lngRow As Long          'Номер текущей строки
Dim intCol As Integer       'Номер текущего столбца
Dim i As Integer
Dim Result As Boolean
 
Open "C:\1\u8_u5_vba_2.txt" For Input As #2
 
Do Until EOF(2) 'Result = True 'По-хорошему до первого необходимого результата
    Line Input #2, strLine
    Result = strLine Like "*k-eff is*"
    If Result = True Then
        ActiveCell.Value = Val(Trim(Replace(strLine, "k-eff is", "")))
        Close #2
        Exit Sub
      End If
    intCol = 0
    lngRow = lngRow + 1
Loop
Close #2

End Sub



 
:)  Я долго не могла заметить, что с выгрузкой - пока не посмотрела в ячейку, следующую за С167 (прокрутить страницу вниз)... выгрузку сделала, как поняла... - или выгрузите куда вам удобно... МВТ меня опередил...
но вариант для разнообразия оставлю:
Код
Sub FindText()
    Dim fso As Object, txt As Object
    Dim sLine$, Str#, lngRow%, intCol%
 
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set txt = fso.OpenTextFile(ThisWorkbook.Path & "\u8_u5_vba_2.txt")
     
    Do While Not Str <> 0
        sLine = txt.ReadLine
        If InStr(sLine, "k-eff is") > 0 Then
            Str = Split(sLine, "k-eff is")(1)
        End If
    Loop
    txt.Close
With Sheets("Лист1")
lngRow = .Cells(.Rows.Count, "C").End(xlUp).Row
intCol = 3
Range("C167").Offset(lngRow, intCol).Value = Str
End With
    MsgBox "done!"
End Sub
P.S. ЛУЧШЕ (чем я написала прежде) так - немного оптимизировала
Изменено: JeyCi - 12.04.2015 12:23:18
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
Код МВТ работает. Код JeyCi выдаёт ошибку.
Осталось разобраться в 16 строке и взять на заметку.
Все_просто, к сожалению, не знаю что такое «регулярные выражения»
Всем большое спасибо. Тема закрыта.
 
Цитата
Новенький написал: Код JeyCi выдаёт ошибку
у меня ошибку не выдавал - странно, теперь выдаёт исправленный вариант... пропало слово Not :(
(код выше исправлен)
Изменено: JeyCi - 12.04.2015 12:22:10
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
Новенький, Replace заменяет в строке strLine подстроку "k-eff is" на "" - пустоту (т.е. - убирает). Trim удаляет пробелы по краям. Val возвращает числовое значение строки, если строка соответствует числу.
 
МВТ, ещё раз огромное спасибо. Надо будет приспособить мышление - тогда и поиск будет плодотворней и меньше вопросов будет.
JeyCi, выдаёт «Run-time error '13': Type mismatch»
 
Цитата
Новенький написал: JeyCi, выдаёт «Run-time error '13': Type mismatch»
я пас гадать, что у вас за проблема - скопировала код с поста ещё раз в файл xlsm - он отработал (на чистом файле, что в вашем файле, я не знаю - вы не предупреждаете)... успехов
P.S. разве что файл-приёмник и файл-текстовик должны лежать в одной папке, на одном диске... или пропишите путь
Изменено: JeyCi - 12.04.2015 12:52:45
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
Только сейчас увидел бурную деятельность в теме. На всякий случай выкладываю с регуляркой:
Код
Sub getCoef()
    Dim RegEx As Object
    Dim TextLine As String
    Dim temp As Object
    Set RegEx = CreateObject("vbscript.regexp")
    With RegEx
        .Global = True
        .IgnoreCase = True
        .MultiLine = True
        .Pattern = "k-eff is\s*(.*)"
    End With
    Open sFolder & sFile For Input As #1
    Do While Not EOF(1)
        Line Input #1, TextLine
        If RegEx.Test(TextLine) Then
            Set temp = RegEx.Execute(TextLine)
            Debug.Print temp.Item(0).SubMatches.Item(0)
            Exit Do
        End If
    Loop
    Close #1
End Sub
sFolder и sFile - константы с названием папки и названием файла соответственно. Коэффициент печатается в immediate window.
Изменено: Все_просто - 12.04.2015 12:56:00
С уважением,
Федор/Все_просто
 
JeyCi, если всё ещё интересно, то пошаманив так, всё заработало. Объяснить не могу, так как не могу найти ошибку даже в своём самом первом коде.
Код
Sub FindText2()
    Dim fso As Object, txt As Object
    Dim sLine As Variant, Str As Variant, lngRow As Integer, intCol As Integer    'Изменил сейчас
  
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set txt = fso.OpenTextFile("L:\vba85\u8_u5_vba_2.txt.out")     'Путь изменил. Раньше тоже менял - была ошибка
      
    Do While Not Str <> 0
        sLine = txt.ReadLine
        If InStr(sLine, "k-eff is") > 0 Then
            Str = Split(sLine, "k-eff is")(1)
        End If
    Loop
    txt.Close
'With Sheets("u8_u5")                                              'Изменил сейчас. Раньше менял название листа - была ошибка
'lngRow = .Cells(.Rows.Count, "C").End(xlUp).Row                   'Изменил сейчас
'intCol = 3                                                        'Изменил сейчас
Range("C167").Offset(lngRow, intCol).Value = Str
intCol = 0                                                         'Добавил
lngRow = lngRow + 1                                                'Добавил
'End With                                                          'Изменил сейчас
    MsgBox "done!"
End Sub
Всё-равно большое спасибо.
 
Цитата
Новенький написал: пошаманив так, всё заработало
предупреждала ведь, что не совсем поняла, куда выгружаете, т к не было примера-файла... в след раз прикладывайте файл (куда нужен макрос) согласно Правил в реальной структуре данных... (в придачу к доп файлам-источникам, если имеются)... отлично, что работает... шаманьте наздоровье 8) ... то, что у вас сработала, можно укоротить здесь...
Код
txt.Close
Range("C167").Value = Str
MsgBox "done!"
Изменено: JeyCi - 12.04.2015 17:09:12
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
JeyCi, я файлы свои хотел выложить, но они по размеру не подошли, поэтому решил ограничиться своим кодом. Ещё раз спасибо. Вам тоже успехов.
Все_просто, Ваш код работает. Вам тоже большое спасибо.
В общем всем огромнейшее спасибо за помощь в праздничный воскресный день. Думаю трёх вариантов будет более чем достаточно и мне и кому-нибудь ещё.
Всем удачи и с праздником!
Изменено: Новенький - 12.04.2015 13:45:54
Страницы: 1
Наверх