行入力を使用して文字列を検索してからExcelセルの次の5行を印刷する方法

StackOverflow https://stackoverflow.com//questions/21067749

  •  26-12-2019
  •  | 
  •  

質問

文字列を検索する方法、次に文字列が見つかった場合は、文字列が見つかった行全体を書き、次に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:...へのすべてのものを、同じセルに、How to fix:...ラインのデータと一緒に記述しようとしています。

Input Lineがラインブレークで自動的に停止して次の行に移動することを知っています。 My 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を使用して、フラットを除去するためにラインブレイク（|に置き換えて）を削除します。
  • は、2番目のRegExp
    • と各一致を抽出します。

FilePathを変更しますここで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
.

入力

テスト 備考方法：この機能を削除するには、次のレジストリキーの設定を設定します。 Hive：HKEY_LOCAL_MACHINE
パス：System \ CurrentControlSet \ Services ...
キー：keykey
タイプ：dword
値：somevalue
関連リンク：いくつかのURL OtherStuff
備考方法：この機能を削除するには、次のレジストリキーの設定を設定します。 ハイブ：HKEY_LOCAL_MACHINE パス：System \ CurrentControlSet \ Services ...
キー：keykey
タイプ：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
.

これは私にとって機能します...

まず、テキストファイルにテキストを変数に割り当てます（以下の例の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"関数を使ってmy_txtをクリーンアップすることもできます。

ライセンス： CC-BY-SA と 帰属
所属していません StackOverflow
scroll top