Find和FindNext
我是VBA新手，需要一些帮助。 经过在互联网上search和实验代码的日子，我不能得到它的工作。
@brettdj，@ ryguy7272非常感谢。 你的代码都能正常工作，但我现在明白我没有正确解释我的问题。 您不需要编写完整的代码，只需显示如何继续使用第二个dynamic范围。 所以，如果你忍受我，这里是完整的解释：
在sheet1中有六个dynamic范围（共48个范围），被复制到sheet2中的48个静态单元。
对于dynamic范围：列“A”具有文本作为开始和结束值。 其他5列有文本作为起始值和空单元格作为结束值。
Sheet1，col“A”，find第一个occ。 （textstring）“ABC”。
Sheet1，col“A”，find第一个occ。 （textstring）“DEF *”（“*”表示任何字符），在“ABC”之后。
这个dynamic范围应复制到Sheet2，“A2”
Sheet1，col“B”，find第一个occ。 （textstring）“GHI”
Sheet1，col“B”，find第一个occ。 （“文字串”）“”（空单元格）之后的“GHI”
这个dynamic范围应复制到Sheet2，“C2”
等等
等等
下面你可以阅读我迄今为止使用过的代码，可以通过列来完成，但是当我重新开始在Col“A”和下一个occ时，我被卡住了。 “ABC”，dynamic地到下一个occ。 “DEF *。
IE：
Sheet1，col“A”，find第二个occ。 “ABC”
Sheet1，col“A”，find第二个occ。 “ABC”之后的“DEF *”，
这个dynamic范围应复制到Sheet2，“A22”
Sheet1，col“B”，find第二个occ。 “GHI”
Sheet1，col“B”，find第二个occ。 “GHI”之后的“”（空单元格）
这个dynamic范围应复制到Sheet2，“C22”
等等（下面的代码）
Sheet1：rows = dynamic。 栏目：1,2,3,4,5,9
Sheet2：8个静态行= 2,22,42,62,82,102,122,142。 栏目：1,3,6,7,9,18
Sub Module1() Dim foundA As Range, _ foundB As Range Dim newSht As Worksheet Application.ScreenUpdating = False On Error GoTo Terminate With Sheets("Sheet1").Columns(1) Set foundA = .Find("ABC") Set foundB = .Find("DEF*", After:=foundA, SearchDirection:=xlNext) End With Range(foundA(2), foundB(0)).Copy Set newSht = Sheets("Sheet2") newSht.Range("A2").PasteSpecial With Sheets("Sheet1").Columns(2) Set foundA = .Find("GHI") Set foundB = .Find("", After:=foundA, SearchDirection:=xlNext) End With Range(foundA(2), foundB(0)).Copy Set newSht = Sheets("Sheet2") newSht.Range("C2").PasteSpecial With Sheets("Sheet1").Columns(3) Set foundA = .Find("JKL") Set foundB = .Find("", After:=foundA, SearchDirection:=xlNext) End With Range(foundA(2), foundB(0)).Copy Set newSht = Sheets("Sheet2") newSht.Range("F2").PasteSpecial With Sheets("Sheet1").Columns(4) Set foundA = .Find("MNO") Set foundB = .Find("", After:=foundA, SearchDirection:=xlNext) End With Range(foundA(2), foundB(0)).Copy Set newSht = Sheets("Sheet2") newSht.Range("G2").PasteSpecial With Sheets("Sheet1").Columns(5) Set foundA = .Find("PQR") Set foundB = .Find("", After:=foundA, SearchDirection:=xlNext) End With Range(foundA(2), foundB(0)).Copy Set newSht = Sheets("Sheet2") newSht.Range("I2").PasteSpecial With Sheets("Sheet1").Columns(9) Set foundA = .Find("STU") Set foundB = .Find("", After:=foundA, SearchDirection:=xlNext) End With Range(foundA(2), foundB(0)).Copy Set newSht = Sheets("Sheet2") newSht.Range("R2").PasteSpecial Exit Sub Terminate: MsgBox "Error in Code" End Application.ScreenUpdating = True End Sub 我希望这是可以理解的。 如果没有请澄清。 任何帮助将不胜感激。 谢谢！
按照你的问题，你可以使用Find和Findnext ：
Sub Update() Dim rng1 As Range Dim rng2 As Range Dim rng3 As Range Dim StrIn As String Dim strAdd As String Dim lngCnt As Long StrIn = "ABC" With Worksheets(1).Columns(1) Set rng1 = .Find(StrIn, .Cells(Rows.Count, "A"), xlValues, xlWhole, xlNext) If Not rng1 Is Nothing Then strAdd = rng1.Address Set rng2 = rng1 Do Set rng1 = .FindNext(rng1) Set rng2 = Union(rng2, rng1) Loop While Not rng1 Is Nothing And rng1.Address <> strAdd End If End With If rng2 Is Nothing Then Exit Sub For Each rng3 In rng2 lngCnt = lngCnt + 1 rng3 = "code " & lngCnt Next End Sub
这应该做你想要的。
Sub Insert() Dim rng As Range Set rng = Range("A1") While rng.Value <> "" If rng.Value = "ABC" Then rng.Offset(1, 0).EntireRow.Insert Set rng = rng.Offset(1) End If Set rng = rng.Offset(1) Wend End Sub