줄 입력을 사용하여 문자열을 검색한 후 Excel 셀에서 다음 5줄을 인쇄하려면 어떻게 해야 합니까?

Question

문자열을 검색한 다음 문자열이 발견되면 문자열이 발견된 전체 줄을 쓴 다음 VBA를 사용하여 Excel의 동일한 셀에 다음 5줄을 작성합니까?

기본적으로 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
길:시스템\현재컨트롤세트\서비스...
열쇠:썸키
유형:DWORD
값:SomeValue
관련된 링크들:일부 url otherstuff
어떻게 고치는 지:이 기능을 제거하려면 다음 레지스트리 키 설정을 지정하십시오.
하이브:hkey_local_machine 경로 :시스템\현재컨트롤세트\서비스...
열쇠:썸키
유형:DWORD
값:SomeValue2
관련된 링크들:일부 URL2

산출

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를 정리할 수도 있습니다.