Wie suche ich mithilfe der Zeileneingabe nach einer Zeichenfolge und drucke dann die nächsten 5 Zeilen in einer Excel-Zelle aus?

Question

Wie suche ich nach einer Zeichenfolge und schreibe, wenn die Zeichenfolge gefunden wird, die gesamte Zeile, in der die Zeichenfolge gefunden wird, und dann die nächsten fünf Zeilen mithilfe von VBA in dieselbe Zelle in Excel?

Im Grunde habe ich eine Textdatei, die ich mit VBA in Excel importiere.Basierend auf einer Zeichenfolge werden Daten aus der Datei in Zellen unter der entsprechenden Spaltenüberschrift eingefügt.Das Problem, das ich habe, ist, dass einige meiner Daten bei einem Zeilenumbruch abgeschnitten werden.Aufgrund der Einschränkung von Line Input.

Diese Bedingung tritt nicht bei allen Werten auf, sondern nur bei denen mit Zeilenumbrüchen wie diesem:

    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

Ich versuche, alles herauszuholen How to Fix:... Zu Value:... in meine Excel-Tabelle schreiben, in derselben Zelle zusammen mit den Daten darauf How to fix:... Linie.

ich weiß, dass Input Line stoppt automatisch bei Zeilenumbrüchen und geht zur nächsten Zeile über.Welches, ohne das My loop Versuche, ist das, was der folgende Code tut.

 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

Ich habe es auch mit a versucht FileSystemObject Es wird jedoch nichts in das Excel-Arbeitsblatt gedruckt.Der Code ist unten:

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

Dieser Code

• verwendet a RegExp um die Zeilenumbrüche zu entfernen (ersetzt durch a |), um sie dann zu glätten
• extrahiert dann jede Übereinstimmung mit einer Sekunde RegExp

Ändern Sie hier Ihren Dateipfad c:\temo\test.txt

Beispieleingabe und -ausgabe unten

Code

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

Eingang

Testen Sie, wie man repariert:Um diese Funktionalität zu entfernen, legen Sie die folgenden Registrierungsschlüsseleinstellungen fest:
Bienenstock:HKEY_LOCAL_MACHINE
Weg:System\CurrentControlSet\Services...
Schlüssel:SomeKey
Typ:DWORD
Wert:Irgendein Wert
Verwandte Links:Einige URL OTHERSTUFF
Wie repariert man:Um diese Funktionalität zu entfernen, legen Sie die folgenden Registrierungsschlüsseleinstellungen fest:
Bienenstock:HKEY_LOCAL_MACHINE PATH:System\CurrentControlSet\Services...
Schlüssel:SomeKey
Typ:DWORD
Wert:SomeValue2
Verwandte Links:Einige URL2

Ausgabe

Answer 2

Hier ist der vollständige Code

  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

Das funktioniert bei mir...

Weisen Sie zunächst den Text in der Textdatei einer Variablen zu (my_var im Beispiel unten).

  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

Wenn Sie möchten, können Sie my_txt auch mit der Funktion „replace“ bereinigen.