Question

我是VBA的新手，需要一些帮助。经过几天的互联网搜索和实验代码，我无法让它发挥作用。

@brettdj，@ ryguy7272 非常感谢。你的代码都很完美，但我现在理解我还没有正确解释我的问题。您不需要编写完整的代码，只是展示如何继续第二个动态范围。所以，如果你忍受我，这里有完整的解释：

我在sheet1的六列中有八个动态范围（总共48个范围），要复制到sheet2中的48个静态单元格。

对于动态范围：Col＆＃34; A＆＃34;将文本作为开始和结束值。其他5列将文本作为起始值，将空单元格作为结束值。

Sheet1，col＆＃34; A＆＃34;，找到第一个occ。 of（textstring）＆＃34; ABC＆＃34;。

Sheet1，col＆＃34; A＆＃34;，找到第一个occ。 of（textstring）＆＃34; DEF *＆＃34; （＆＃34; *＆＃34;表示任何角色），＆＃34; ABC＆＃34;。

此动态范围应复制到Sheet2，＆＃34; A2＆＃34;

Sheet1，col＆＃34; B＆＃34;，找到第一个occ。 of（textstring）＆＃34; GHI＆＃34;

Sheet1，col＆＃34; B＆＃34;，找到第一个occ。 of（textstring）＆＃34;＆＃34; （空单元格）＆＃34; GHI＆＃34;

此动态范围应复制到Sheet2，＆＃34; C2＆＃34;

等

下面你可以阅读我到目前为止使用的代码，按列进行，但是当我重新开始在Col＆＃34; A＆＃34;和下一个occ时，我会陷入困境。＆＃34; ABC＆＃34;，动态地到下一个occ。＆＃34; DEF *。

即：

Sheet1，col＆＃34; A＆＃34;，找到第二个。＆＃34; ABC＆＃34;

Sheet1，col＆＃34; A＆＃34;，找到第二个。＆＃34; DEF *＆＃34;，＆＃34; ABC＆＃34;

此动态范围应复制到Sheet2，＆＃34; A22＆＃34;

Sheet1，col＆＃34; B＆＃34;，找到第二个。＆＃34; GHI＆＃34;

Sheet1，col＆＃34; B＆＃34;，找到第二个。＆＃34;＆＃34; （空单元格）＆＃34; GHI＆＃34;

此动态范围应复制到Sheet2，＆＃34; C22＆＃34;

等等（以下代码）

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

我希望这是可以理解的。如果没有，请要求澄清。任何帮助将不胜感激。谢谢！

Answer 1

根据您的问题，您可以使用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

Answer 2

这应该做你想要的。

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

查找和查找下一页

我是VBA的新手，需要一些帮助。经过几天的互联网搜索和实验代码，我无法让它发挥作用。

2 个答案: