使用两个对应的数组遍历命名范围

Question

循环遍历命名范围，如果单元格匹配，则它将调整大小的范围粘贴到不同的工作表中。我想为不同的范围使用一个循环，而不是为每个范围编写相同的代码。我考虑过使用数组，但我不知道如何处理 F 列中的数据（见下文）。

下面的代码行会将匹配的数据粘贴到与 A:D

列不同的工作表中

cell.Offset(, -3).Resize(, 4).Copy Destination:= _
           Sheets("CAR Issues").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

此行将值从命名范围粘贴到列 F。

Sheets("CAR Issues").Cells(Rows.Count, 1).End(xlUp).Offset(, 4).Value = Sheets("Boards").Range("UFFCAR").Value

是否可以让这个循环使用两个对应的数组，即

Unit = Array("UFF", "ERF", "DOF") < Data from column A:E
UM = Array("UFFCAR", "ERFCAR", "DOFCAR") Data in column F

完整代码

Sub Test()

Dim cell As Range

With Sheets("Boards")
   For Each cell In .Range("UFF")
        If cell.Value = "CAR" Then
          cell.Offset(, -3).Resize(, 4).Copy Destination:= _
           Sheets("CAR Issues").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
         Sheets("CAR Issues").Cells(Rows.Count, 1).End(xlUp).Offset(, 4).Value = Sheets("Boards").Range("UFFCAR").Value
        End If
    Next cell
End With

Call Test2

End Sub

Sub Test2()


Dim cell As Range
    

With Sheets("Boards")
   For Each cell In .Range("ERF")
        If cell.Value = "CAR" Then
          cell.Offset(, -3).Resize(, 4).Copy Destination:= _
           Sheets("CAR Issues").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
         Sheets("CAR Issues").Cells(Rows.Count, 1).End(xlUp).Offset(, 4).Value = Sheets("Boards").Range("ERFCAR").Value
        End If
    Next cell
End With

End Sub

Answer 1

如果我理解正确以避免第二个子项，您可以通过相同的数组索引引用您的数组（例如，通过 Unit(i) 和 UM(i)；默认情况下，此处的数组将从零开始）：

Sub doSomething()
    Dim Unit: Unit = Array("UFF", "ERF", "DOF")             '< Data from column A:E
    Dim UM:     UM = Array("UFFCAR", "ERFCAR", "DOFCAR")    '< Data in column F
    Dim i As Long
    For i = LBound(uff) To UBound(Unit)                     ' assumes same boundary as UM
        With ThisWorkbook.Worksheets("Boards")              ' fully qualified range reference!
            Dim cell As Range
            For Each cell In .Range(Unit(i))                '< get index i from Unit
                If cell.Value = "CAR" Then
                    cell.Offset(, -3).Resize(, 4).Copy _
                        Destination:=ThisWorkbook.Sheets("CAR Issues").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                    Thisworkbook.Worksheets("CAR Issues").Cells(Rows.Count, 1).End(xlUp).Offset(, 4).Value = _
                        .Range(UM(i)).Value                 '< get index i from UM
                End If
            Next cell
        End With
    Next i
End Sub

提示： 我会通过项目的 Code(Name) 引用工作表，例如

Sheet1.Range(...)

而不是

ThisWorkbook.Worksheets("XY").Range(...)

注意：顺便说一句，命名范围 DOF 在您的原始代码中未提及。

Answer 2

如果我正确理解了您的问题，请尝试下一种方法：

Sub testNamesIteration()
  Dim shCI As Worksheet, Unit As Variant, UM As Variant
  Dim El As Variant, cell As Range, i As Long
  
  Set shCI = Sheets("CAR Issues")
  Unit = Array("UFF", "ERF", "DOF") ' Data from column A:E
  UM = Array("UFFCAR", "ERFCAR", "DOFCAR")
  
  With Sheets("Boards")
    For Each El In Unit
         For Each cell In .Range(El)
            If cell.Value = "CAR" Then
               cell.Offset(, -3).Resize(, 4).Copy Destination:= _
                         shCI.cells(rows.count, 1).End(xlUp).Offset(1, 0)
               shCI.cells(rows.count, 1).End(xlUp).Offset(, 4).Value = _
                                                    .Range(UM(i)).Value
            End If
        Next cell
        i = i + 1
    Next
  End With
End Sub

上面的代码假设两个数组元素之间存在对应关系。我的意思是，如果是第一个数组的第一个元素，则将复制第二个数组的第一个元素...