简体   繁体   中英

How to Find specific text word using Excel vba

I need to find a specific word from an Excel file. I want to search row by row, and if the word is found, skip 2 rows down and copy the next 20 rows and loop to the next word.

Sub Example4()

Dim FilePath As Workbook    
Dim wsheet As Worksheet
Dim i, lcount, lcount2 As Integer
 Dim cell, rgFound As Range
Dim Found As Range, LastRow As Long


 Set FilePath = Workbooks.Open("D:\SLC.txt")
  Dim rowVal As Integer
    rowVal = 1

    For lcount = 1 To FilePath.Sheets("SLC").Range("A1048576").End(xlUp).Row

    Set rgFound = Range("A1:A1048576").Find("TXN. NO     TXN SEQ", ThisWorkbook.Sheets(), Cells(rowVal, 1))


            FilePath.Cells(wsheet.Range(rowVal).End(xlDown).Row + 3).xlCopy

            wbook2.Worksheets(1).Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
            wbook2.SaveAs ("D:\SLC_Copied.xlsx")
            wbook2.Close

   rowVal = rgFound1.Row

   Debug.Print lcount
   Next lcount


End Sub

As Siddharth Rout suggested, use Find and FindNext. Try to choose variable names appropriate to their type, calling a workbook object FilePath is confusing to others trying to understand your script.

Option Explicit
Sub Example4()

    Const TEXT = "TXN. NO     TXN SEQ"
    Const TEXT_FILENAME = "D:\SLC.txt"
    Const OUT_FILENAME = "D:\SLC_Copied.xlsx"

    Dim wbText As Workbook, wbOut As Workbook, rngOut As Range
    Dim wsText As Worksheet, wsOut As Worksheet, count As Integer
    Dim rngSearch As Range, rngFound As Range, rowFirstFind As Long

    ' open text file no link update, read only
    Set wbText = Workbooks.Open(TEXT_FILENAME, False, True)
    Set wsText = wbText.Sheets(1)

    ' search
    Set rngSearch = wsText.Columns("A:A")
    Set rngFound = rngSearch.Find(what:=TEXT, LookIn:=xlValues, LookAt:=xlPart)

    If rngFound Is Nothing Then
        wbText.Close
        MsgBox "No lines match [" & TEXT & "]", vbCritical, "Exiting Sub"
        Exit Sub
    Else

        ' create new workbook for results
        Set wbOut = Workbooks.Add
        Set wsOut = wbOut.Sheets(1)
        Set rngOut = wsOut.Range("A1")
        rowFirstFind = rngFound.Row

        Do
            'Debug.Print rngFound.Row
            rngFound.Offset(3, 0).Resize(20, 1).Copy rngOut
            Set rngOut = rngOut.Offset(20, 0)
            Set rngFound = rngSearch.FindNext(rngFound)
            count = count + 1
        Loop Until rngFound.Row = rowFirstFind

    End If
    wbText.Close False

    wbOut.SaveAs OUT_FILENAME
    MsgBox count & " blocks copied to " & wbOut.Name, vbInformation, "Finished"
    wbOut.Close

End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM