¿Cómo puedo buscar una cadena usando la Línea de Entrada y, a continuación, imprimir el próximo 5 líneas en la celda de Excel

Question

¿Cómo puedo buscar una cadena, entonces cuando la cadena se encuentra, escribir toda la línea donde la cadena se encuentra y, a continuación, los próximos cinco líneas en la misma Celda en Excel con VBA?

Básicamente, tengo un archivo de texto que estoy importar en Excel con VBA.Basado en una cadena de datos desde el archivo entra en las células bajo el encabezado de la columna correspondiente.El problema que estoy teniendo es que algunos de mis datos se cortan en un salto de línea.Debido a la limitación de Line Input.

Esta condición no ocurre para todos los valores, sólo aquellos con los saltos de línea 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

Estoy tratando de conseguir de todo, desde How to Fix:... a Value:... para escribir en mi hoja de Excel, en la misma Celda junto con los datos de la How to fix:... de la línea.

Sé que Input Line automáticamente se detiene en los saltos de línea y pasa a la línea siguiente.Que, w/s de la mi loop los intentos, es lo que el código siguiente.

 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

También he intentado usar un FileSystemObject pero no imprime nada a la hoja de cálculo de Excel.El código es el siguiente:

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

• utiliza un RegExp para quitar la puedes incluir varias líneas (sustituido con un |) para acoplar a continuación, la cadena de
• a continuación, extractos de cada partido con un segundo RegExp

cambia tu ruta aquí c:\temo\test.txt

ejemplo de entrada y de salida en la 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

de entrada

prueba Cómo Solucionarlo:Para eliminar esta funcionalidad, establezca la siguiente clave del Registro de configuración:
Colmena:HKEY_LOCAL_MACHINE
Ruta de acceso:System\CurrentControlSet\Services...
Clave:SomeKey
Tipo:DWORD
Valor:SomeValue
Enlaces Relacionados:Parte de la URL otherstuff
Cómo Solucionarlo:Para eliminar esta funcionalidad, establezca la siguiente clave del Registro de configuración:
Colmena:HKEY_LOCAL_MACHINE Ruta de acceso:System\CurrentControlSet\Services...
Clave:SomeKey
Tipo:DWORD
Valor:SomeValue2
Enlaces Relacionados:Algunos URL2

salida

Answer 2

Aquí está el 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

Esto funciona para mí...

Primero, asigne el texto del archivo de texto a una variable (my_var en el ejemplo siguiente)

  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

También puedes limpiar my_txt usando la función "reemplazar" si lo deseas.