时间戳

首页 > 解决方案 > 使用两个对应的数组遍历命名范围

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

问题描述

循环遍历命名范围，如果单元格匹配，则它将调整大小的范围粘贴到不同的工作表中。我想为不同的范围使用一个循环，而不是为每个范围编写相同的代码。我考虑过使用数组，但我不知道如何处理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

标签： arraysexcelvba

解决方案

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

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

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

推荐阅读