Question

我的wsI中具有相同的许多命名范围，具有不同的标签（具有不同行号但具有相同列号的列表）（例如listA = Sheet1！$ A $ 2：$ E $ 4，listB = Sheet1！$ A $ 5：$ E $ 6等）。现在，我想在wsO中复制我的“命名范围”，此代码可以正常工作：

 Sub CopyNamedRange()
 Dim wsI As Worksheet, wsO As Worksheet

 Set wsI = ThisWorkbook.Sheets("Sheet1")
 Set wsO = ThisWorkbook.Sheets("Sheet2")

 wsO.Range("A1")= "listA"
 wsO.Range("listA").Copy wsO.Range("B1") 

 End Sub

结果是，如果在Sheet2！A1中写了“ listA”，则将ListA单元从Sheet1！$ A $ 2：$ E $ 4复制到Sheet2！$ B $ 1：$ F $ 3。现在，我想知道是否有可能创建一个宏，该宏循环遍历wsI中我的命名范围的所有标签，并根据Sheet2！A1中的值复制所有单元格。其次，我将在Sheet2的“ A”列中引入第二个循环，以查找所有不同的“ listX”（例如，listA，listB，listA，listC，listB等）并自动复制Sheet2中的单元格（显然，如果A1 = listA从1到3占据3行，则A列中带有“ listX”的下一个单元格将在A4中，依此类推）。

Answer 1

方法如下：

Option Explicit
Sub Test()

    Dim MyNAmes As Name

    For Each MyNAmes In ThisWorkbook.Names
        'Your code
    Next MyNAmes

End Sub

Answer 2

如果有人感兴趣，请在此处输入我的问题代码：

  Option Explicit
  Sub Protocols()
  ActiveSheet.UsedRange.Select
  Dim wsI As Worksheet, wsO As Worksheet
  Dim cell As Range
  Dim nm As Name

  Set wsI = ThisWorkbook.Sheets("Sheet1")
  Set wsO = ThisWorkbook.Sheets("Sheet2")

  On Error Resume Next

  For Each cell In Columns("A").Cells
  If IsEmpty(cell) = True Then
  Else
  For Each nm In ThisWorkbook.Names
  If cell.Value = nm.Name Then Exit For
  Next nm
  wsI.Range(nm.Name).Copy wsO.Cells(cell.Row, "B")
  End If
  Next cell

  On Error GoTo 0
  End Sub

现在的疑问是：是否可以仅在Sheet1（示例中为wsI）中存储的Named Range（而不是整个工作簿）中限制nm Name搜索？我试图更换

  For Each nm In ThisWorkbook.Names

使用

  For Each nm In wsI.Names

但似乎不起作用。

有什么想法吗？您认为有可能吗？

P.S .：只是将研究限制在“命名范围”内，避免不必要的循环！

如何自动遍历命名范围标签

2 个答案: