Question

我正面临VBA的一些问题。让我解释一下我想要实现的目标。我在1个工作簿中有2张。它们被标记为“Sheet1”和“Sheet2”。

在“Sheet1”中，有100行和100列。在A列中，它充满了例如：SUBJ001一直到SUBJ100。在“Sheet2”中，只有一个A列，具有一系列行。例如：“SUBJ003，SUBJ033，SUBJ45。”我想要实现的是使用我的鼠标，突出显示“Sheet2”中的A列，并将每个单独的单元格与A列中的单元格进行比较。如果匹配，它将复制整行并将其粘贴到宏在同一工作簿中创建的新工作表。但是，我在Set Rng =遇到超出范围的错误.Find（What：= Arr（I），...谢谢！

Sub Copy_To_Another_Sheet_1()
Dim FirstAddress As String
Dim MyArr As Variant
Dim Rng As Range
Dim Rcount As Long
Dim I As Long
Dim NewSh As Worksheet

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

Set Rng = Application.InputBox("Select target range with the mouse", Type:=8)

MyArr = Rng

Set NewSh = Worksheets.Add

With Sheets("Sheet1").Range("A:A")

    Rcount = 0

    For I = LBound(MyArr) To UBound(MyArr)

        Set Rng = .Find(What:=MyArr(I), _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlFormulas, _
                        LookAt:=xlPart, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
        If Not Rng Is Nothing Then
            FirstAddress = Rng.Address
            Do
                Rcount = Rcount + 1

                Rng.EntireRow.Copy NewSh.Range("A" & Rcount)

                ' Use this if you only want to copy the value
                ' NewSh.Range("A" & Rcount).Value = Rng.Value

                Set Rng = .FindNext(Rng)
            Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
        End If
    Next I
End With

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

End Sub

Answer 1

MyArr = Rng将MyArr设置为二维数组，其中第一个排名对应Rng中的行，第二个排名对应Rng中的列

假设您在Rng中只有一列，那么您的Find语句应使用MyArr(I, 1)引用该第一列中的值，即

    Set Rng = .Find(What:=MyArr(I, 1), _
                    After:=.Cells(.Cells.Count), _
                    LookIn:=xlFormulas, _
                    LookAt:=xlPart, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)

在VBA中将范围插入数组以进行迭代

1 个答案: