Come cercare una stringa usando l'ingresso di linea e quindi stampare le 5 righe successive in cella di Excel

Question

Come posso cercare una stringa, quindi quando viene trovata la stringa, scrivi l'intera riga in cui viene trovata la stringa, quindi le prossime cinque righe nella stessa cella in Excel usando VBA?

Fondamentalmente, ho un file di testo che sto importando in Excel usando VBA. Sulla base di una stringa, i dati del file vanno in celle sotto l'intestazione della colonna appropriata. Il problema che sto avendo è che alcuni dei miei dati vengono tagliati a una rottura della linea. A causa della limitazione del Line Input.

Questa condizione non accade per tutti i valori, solo quelli con la linea si rompe come questo:

    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

.

Sto cercando di ottenere tutto da How to Fix:... a Value:... per scrivere al mio foglio Excel, nella stessa cella insieme ai dati sulla linea How to fix:....

So che Input Line si arresta automaticamente alle interruzioni di linea e si sposta sulla riga successiva. Che, w / o i miei tentativi dei miei loop, è ciò che il codice seguente lo fa.

 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

.

Ho anche provato a utilizzare un FileSystemObject ma non stampa nulla al foglio di lavoro Excel. Il codice è sotto:

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

Questo codice

.
• Utilizza un RegExp per rimuovere i designi (sostituiti con un |) da appiattire quindi stringa
• Quindi estrae ogni partita con un secondo RegExp

Cambia il tuo filepath qui c:\temo\test.txt

Ingresso campione e uscita in basso

Codice

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

.

ingresso

.

Test Come correggere: Per rimuovere questa funzionalità, impostare le seguenti impostazioni della chiave del registro:
Hive: HKEY_LOCAL_MACHINE
Path: System \ CurrentControlSet \ Servizi \ Servizi ...
Chiave: someyy
Tipo: DWORD
Valore: Somevaloue
Link correlati: qualche URL otherstuff
. Come correggere: Per rimuovere questa funzionalità, impostare le seguenti impostazioni della chiave del registro:
Hive: hkey_local_machine. Path: System \ CurrentControlSet \ Servizi \ Servizi ...
Chiave: someyy
Tipo: DWORD
Valore: SOMEVALUE2
Link correlati: alcuni URL2

output

Answer 2

Ecco il codice 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

.

funziona per me ...

In primo luogo, assegna il testo nel file di testo a una variabile (my_var nell'esempio seguente)

  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

.

È inoltre possibile ripulire My_txt utilizzando la funzione "Sostituisci" se ti piace.