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

Question

我在使用 VBA 时遇到了一些问题。让我解释一下我想要实现的目标。我在 2 个工作簿中有 1 张纸。它们被标记为"Sheet1"和"Sheet2"。

在"Sheet1"中，有 100 行和 100 列。在 A 列中，它填充了 eg：SUBJ001一直到 SUBJ100。在"Sheet2"中，只有 1 列 A，具有一系列行。例如："SUBJ003，SUBJ033，SUBJ45。我试图实现的是使用鼠标，突出显示"Sheet2"中的A列，然后将每个单独的单元格与A列中的单元格进行比较.如果匹配，它将复制整行并将它们粘贴到宏在同一工作簿中创建的新工作表中。但是，我在设置 Rng = 时遇到超出范围的错误。查找（什么：=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

结束子

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)