如何使用行输入搜索字符串，然后在 Excel 单元格中打印接下来的 5 行

Question

如何使用 VBA 搜索字符串，然后在找到该字符串时，将找到该字符串的整行写入，然后将接下来的五行写入 Excel 中的同一单元格中？

基本上，我有一个文本文件，我正在使用 VBA 将其导入到 Excel 中。基于字符串，文件中的数据将进入相应列标题下的单元格中。我遇到的问题是我的一些数据在换行符处被切断。由于限制 Line Input.

并非所有值都会发生这种情况，只有像这样带有换行符的值才会发生这种情况：

    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

我试图从中获得一切 How to Fix:... 到 Value:... 写入我的 Excel 工作表，在同一个单元格中以及 How to fix:... 线。

我知道 Input Line 自动在换行符处停止并移至下一行。其中，没有我的 loop 尝试，就是下面的代码所做的。

 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

我也尝试使用 FileSystemObject 但它不会向 Excel 工作表打印任何内容。代码如下：

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

这段代码

• 使用一个 RegExp 删除换行符（替换为 |）压平然后串起来
• 然后提取每个匹配的第二个 RegExp

在这里更改您的文件路径 c:\temo\test.txt

底部的示例输入和输出

代码

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

输入

测试如何修复：要删除此功能，请设置以下注册表项设置：
蜂巢：HKEY_LOCAL_MACHINE
小路：系统\当前控制集\服务...
钥匙：某键
类型：双字
价值：一些价值
相关链接：一些URL Otherstuff
怎么修：要删除此功能，请设置以下注册表项设置：
蜂巢：hkey_local_machine路径：系统\当前控制集\服务...
钥匙：某键
类型：双字
价值：一些值2
相关链接：一些网址2

输出

Answer 2

这是完整的代码

  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

这对我有用...

首先，将文本文件中的文本分配给一个变量（下例中的 my_var）

  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

如果您愿意，您还可以使用“替换”功能清理 my_txt。