Como procuro uma string usando Line Input e imprimo as próximas 5 linhas na célula do Excel

Question

Como procuro uma string e, quando a string for encontrada, escrevo a linha inteira onde a string foi encontrada e as próximas cinco linhas na mesma célula do Excel usando VBA?

Basicamente, tenho um arquivo de texto que estou importando para o Excel usando VBA.Com base em uma string, os dados do arquivo vão para as células sob o cabeçalho de coluna apropriado.O problema que estou tendo é que alguns dos meus dados são cortados em uma quebra de linha.Devido à limitação de Line Input.

Esta condição não acontece para todos os valores, apenas aqueles com quebras de linha como esta:

    How To Fix: To remove this functionality, set the following Registry key settings:
    Hive: HKEY_LOCAL_MACHINE
    Path: System\CurrentControlSet\Services...
    Key: SomeKey
    Type: DWORD
    Value: SomeValue
    Related Links: Some URL

Estou tentando obter tudo de How to Fix:... para Value:... escrever na minha planilha Excel, na mesma célula junto com os dados do How to fix:... linha.

eu sei que Input Line para automaticamente nas quebras de linha e passa para a próxima linha.Que, sem o meu loop tentativas, é o que o código abaixo faz.

 If InStr(inputline, "How to Fix:") <> 0 Then
    'Do While Not InStr(inputline, "Related Links:")
    ' Get rid of special characters in string
       For i = 1 To Len(description)
            sletter = Mid(description, i, i + 1)
            iasc = Asc(sletter)
           If Not (iasc <= 153 And iasc >= 32) Then
                  description = Left(description, i - 1) & " " & Right(description, Len(description) - i)
           ' End If

       'Next
       Do Until InStr(inputline, "Related Links:") = 1
            description = Replace(description, "How to Fix:", "")
            ws.Cells(rowndx4, 7).Value = Trim(description)
        Loop
End If

Eu também tentei usar um FileSystemObject mas não imprime nada na planilha do Excel.O código está abaixo:

Private Function ScanFile2$(FileToRead2 As String, rowndx4 As Long)

Dim wb As Workbook, ws As Worksheet, i As Long
Dim FNum3 As Integer, inputline As String, whatfile As Integer, testnum As String
Dim description As String
Dim finding As String

Set ws = ActiveWorkbook.Worksheets("Sheet1")
    FNum3 = FreeFile()

Dim oFSO As FileSystemObject
Set oFSO = New FileSystemObject
Dim TS As TextStream
Const ForReading = 1
Set TS = oFSO.OpenTextFile(FNum3, ForReading)

Do While TS.AtEndOfStream <> True
inputline = TS.ReadAll
description = inputline

If InStr(inputline, "How To Fix:") <> 0 Then
            description = Replace(inputline, "How To Fix:", "")
            ws.Cells(rowndx4, 2).Value = inputline
End If
Exit Do
Loop
Close FNum3
Set ws = Nothing        
Application.ScreenUpdating = True
ScanFile2 = rowndx4
End Function

Answer 1

Este código

• usa um RegExp para remover as quebras de linha (substituídas por um |) para achatar e depois amarrar
• em seguida, extrai cada correspondência com um segundo RegExp

altere seu caminho de arquivo aqui c:\temo\test.txt

amostra de entrada e saída na parte inferior

código

Sub GetText()

Dim objFSO As Object
Dim objTF As Object
Dim objRegex As Object
Dim objRegMC As Object
Dim objRegM As Object
Dim strIn As String
Dim strOut As String
Dim lngCnt As Long

Set objRegex = CreateObject("vbscript.regexp")
Set objFSO = CreateObject("scripting.filesystemobject")
Set objts = objFSO.OpenTextFile("c:\temp\test.txt")

strIn = objts.readall

With objRegex
.Pattern = "\r\n"
.Global = True
.ignorecase = True
strOut = .Replace(strIn, "|")
.Pattern = "(How to Fix.+?)Related"
Set objRegMC = .Execute(strOut)
For Each objRegM In objRegMC
lngCnt = lngCnt + 1
Cells(lngCnt, 7) = Replace(objRegM.submatches(0), "|", Chr(10))
Next
End With

End Sub

entrada

Teste como consertar:Para remover essa funcionalidade, defina as seguintes configurações de chave do Registro:
Colmeia:HKEY_LOCAL_MACHINE
Caminho:Sistema\CurrentControlSet\Serviços...
Chave:Alguma chave
Tipo:DWORD
Valor:Algum valor
Links Relacionados:Alguns URL Otherstuff
Como consertar:Para remover essa funcionalidade, defina as seguintes configurações de chave do Registro:
Colmeia:HKEY_LOCAL_MACHINE PATH:Sistema\CurrentControlSet\Serviços...
Chave:Alguma chave
Tipo:DWORD
Valor:AlgumValor2
Links Relacionados:Alguns URL2

saída

Answer 2

Aqui está o código completo

  Sub test()
  ' Open the text file
    Workbooks.OpenText Filename:="C:\Excel\test.txt"

  ' Select the range to copy and copy
    Range("A1", ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy

  ' Assign the text to a variable
    Set my_object = CreateObject("htmlfile")
    my_var = my_object.ParentWindow.ClipboardData.GetData("text")
  ' MsgBox (my_var)   ' just used for testing
    Set my_object = Nothing

    pos_1 = InStr(1, my_var, "How to fix:", vbTextCompare)
    pos_2 = InStr(pos_1, my_var, "Related Links", vbTextCompare)
    my_txt = Mid(my_var, pos_1, -1 + pos_2 - pos_1)

  ' Return to the original file and paste the data
    Windows("stackoverflow.xls").Activate
    Range("A1") = my_txt

  ' Empty the clipboard
    Application.CutCopyMode = False
  End Sub

Isso funciona para mim ...

primeiro, atribua o texto no arquivo de texto a uma variável (my_var no exemplo abaixo)

  pos_1 = InStr(1, my_var, "How to fix:", vbTextCompare)
  pos_2 = InStr(pos_1, my_var, "Related Links", vbTextCompare)
  my_txt = Mid(my_var, pos_1, -1 + pos_2 - pos_1)
  Range("wherever you want to put it") = my_txt

Você também pode limpar my_txt usando a função "replace", se desejar.