[英]How to Find specific text word using Excel vba
我需要從 Excel 文件中查找特定單詞。 我想逐行搜索,如果找到單詞,向下跳過 2 行並復制接下來的 20 行並循環到下一個單詞。
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
正如 Siddharth Rout 建議的那樣,使用 Find 和 FindNext。 嘗試選擇適合其類型的變量名稱,調用工作簿對象 FilePath 會讓其他試圖理解您的腳本的人感到困惑。
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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.