如何使用“行input”searchstring，然后在Excel单元格中打印下5行
如何search一个string，然后当findstring时，写出findstring的整个行，然后使用VBA将下一个五行写入Excel中相同的单元格？
基本上，我有一个文本文件，我使用VBA导入到Excel中。 根据string，来自文件的数据将进入适当列标题下的单元格中。 我遇到的问题是我的一些数据在换行符处被截断。 由于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
这个代码
- 使用
RegExp删除换行符（replace为|）以平滑string - 然后用第二个
RegExp提取每个匹配
在这里改变你的文件pathc:\temo\test.txt
样本input和输出在底部
码
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
input
testing如何修复：要删除此function，请设置以下registry项设置：
Hive：HKEY_LOCAL_MACHINE
path：System \ CurrentControlSet \ Services …
Key：SomeKey
types：DWORD
值：SomeValue
相关链接：一些URL otherstuff
如何修复：要删除此function，请设置以下registry项设置：
Hive：HKEY_LOCAL_MACHINEpath：System \ CurrentControlSet \ Services …
Key：SomeKey
types：DWORD
值：SomeValue2
相关链接：一些URL2
产量 
这是完整的代码
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
这适用于我…
首先，将文本文件中的文本分配给一个variables（下例中的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
如果你喜欢，你也可以使用“replace”function来清理my_txt。