Excel 从VBA并集中选择图元

我的任务是根据.xls文件中的几个部分制作一个VBA宏。 我知道，在这个文件中，它将始终是以示例文件“Block”中的特定名称开头的三个部分。但每次写入“块”的起始行可能不同

.xls文件的示例：

我的方法是搜索每个包含字符串“Block”的列的地址 然后在知道每个块的起始位置的基础上进一步编写代码。 到目前为止，我的代码是：

Public Values

Sub Macro1()

FindAll ("Block")
Debug.Print Values
'    
End Sub

Sub FindAll(text)

Dim fnd As String, FirstFound As String
Dim FoundCell As Range, rng As Range
Dim myRange As Range, LastCell As Range

  fnd = text

Set myRange = ActiveSheet.UsedRange
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(what:=fnd, after:=LastCell)

'Test to see if anything was found
  If Not FoundCell Is Nothing Then
    FirstFound = FoundCell.Address
  Else
    GoTo NothingFound
  End If

Set rng = FoundCell

'Loop until cycled through all unique finds
  Do Until FoundCell Is Nothing
    'Find next cell with fnd value
      Set FoundCell = myRange.FindNext(after:=FoundCell)
    
    'Add found cell to rng range variable
      Set rng = Union(rng, FoundCell)
    
    'Test to see if cycled through to first found cell
      If FoundCell.Address = FirstFound Then Exit Do
      
  Loop

'Creates global value with all found adresses
  Values = rng.Address
 
Exit Sub

按预期接收输出：

$A$5,$A$8,$A$1

然而，我很难选择元素进行进一步编码。 我试过：

但它会产生“运行时错误'424'”

我希望的输出是创建三个变量，其中包含这些部分的地址。 那

将产生：

$A$1
$A$5
$A$8

---

有没有办法从VBA中的union中选择第n个元素？

如果要访问该区域的单个单元格，只需在其上循环：

Dim cell as Range
For Each cell In rng
    Debug.Print cell.Address
Next

也可以使用索引来完成：

Dim i As Long
For i = 1 To rng.Count
    Debug.Print rng(i).Address
Next

现在在您的示例中，使用Union组合单个单元格。如果组合较大的范围并希望访问这些范围，则可以使用

区域

-属性。但是，Excel将优化这些区域，如果您执行联合（范围（“A1”）、范围（“A2”），您将得到一个区域

A1:A2

With ActiveSheet
    Set rng = Union(.Range("D5:E16"), .Range("A1:F12"), .Range("X4"))
End With

Dim a As Range
For Each a In rng.Areas
    Debug.Print a.Address
Next

For i = 1 to rng.Areas.Count
    Debug.Print rng(i).Address
Next

顺便说一句：每个范围（即使是单个单元格）都有

区域属性集，因此在范围的
区域上循环总是安全的。
试试

Public Values
Public rngDB() As Range
Sub Macro1()
    Dim i As Integer
    FindAll ("Block")
    Debug.Print Values
    
    For i = LBound(rngDB) To UBound(rngDB)
       Debug.Print rngDB(i).Address
       Debug.Print rngDB(i).Cells(1).Address
       Debug.Print rngDB(i).Cells(1, 2).Address
       Debug.Print rngDB(i).Cells(2, 1).Address
    Next i
End Sub

Sub FindAll(text)

    Dim fnd As String, FirstFound As String
    Dim FoundCell As Range, rng As Range
    Dim myRange As Range, LastCell As Range
    Dim sAddress() As String
    Dim n As Integer
    
    fnd = text
    
    Set myRange = ActiveSheet.UsedRange
    Set LastCell = myRange.Cells(myRange.Cells.Count)
    Set FoundCell = myRange.Find(what:=fnd, after:=LastCell)
    
    'Test to see if anything was found
      If Not FoundCell Is Nothing Then
        FirstFound = FoundCell.Address
      Else
        'GoTo NothingFound
      End If
    
    Set rng = FoundCell
    
    'Loop until cycled through all unique finds
        Do
            n = n + 1
            ReDim Preserve rngDB(1 To n)
            ReDim Preserve sAddress(1 To n)
            Set rngDB(n) = FoundCell.CurrentRegion
            sAddress(n) = rngDB(n).Address
            Set FoundCell = myRange.FindNext(after:=FoundCell)
        
        Loop While FoundCell.Address <> FirstFound
    
    'Creates global value with all found adresses
    If n Then
        Values = Join(sAddress, ",")
    End If
 
End Sub

公共价值观
作为范围的公共rngDB（）
亚宏观1（）
作为整数的Dim i
芬德尔（“区块”）
调试。打印值
对于i=LBound（rngDB）到UBound（rngDB）
调试.打印rngDB（i）.地址
调试.打印rngDB（i）.单元格（1）.地址
调试.打印rngDB（i）.单元格（1，2）.地址
调试.打印rngDB（i）.单元格（2，1）.地址
接下来我
端接头
副财务长（正文）
Dim fnd作为字符串，FirstFound作为字符串
Dim FoundCell作为范围，rng作为范围
Dim myRange作为范围，LastCell作为范围
Dim sAddress（）作为字符串
作为整数的Dim n
fnd=文本
设置myRange=ActiveSheet.UsedRange
设置LastCell=myRange.Cells（myRange.Cells.Count）
Set FoundCell=myRange.Find（what:=fnd，after:=LastCell）
“检查是否发现任何东西
如果不是FoundCell，那就什么都不是了
FirstFound=FoundCell.Address
其他的
“什么也找不到
如果结束
设置rng=FoundCell
'循环，直到在所有唯一查找中循环
做
n=n+1
ReDim保留rngDB（1到n）
雷迪姆保持鞍座（1至n）
设置rngDB（n）=FoundCell.CurrentRegion
鞍座（n）=rngDB（n）.地址
设置FoundCell=myRange.FindNext（之后：=FoundCell）
在FoundCell时循环。首次找到地址
'使用所有找到的地址创建全局值
如果n那么
值=连接（鞍座，“，”）
如果结束
端接头
如果您将范围作为分隔字符串，则可以使用
SPLIT
生成一个地址数组，然后可以通过indexin而不是
Value
访问该数组，下面是一些如何继续的示例：
Debug.Print rng.Areas.Count
或：
Debug.Print rng.area（1）.Address
或：
用于rng中的每个arg。区域：Debug.Print arg。Address:Next arg
您得到了行
GoTo NothingFound
，但没有名为
NothingFound
的标签。我会将整个find循环放在If语句中以避免GoTo。
With ActiveSheet
    Set rng = Union(.Range("D5:E16"), .Range("A1:F12"), .Range("X4"))
End With

Dim a As Range
For Each a In rng.Areas
    Debug.Print a.Address
Next

For i = 1 to rng.Areas.Count
    Debug.Print rng(i).Address
Next

Public Values
Public rngDB() As Range
Sub Macro1()
    Dim i As Integer
    FindAll ("Block")
    Debug.Print Values
    
    For i = LBound(rngDB) To UBound(rngDB)
       Debug.Print rngDB(i).Address
       Debug.Print rngDB(i).Cells(1).Address
       Debug.Print rngDB(i).Cells(1, 2).Address
       Debug.Print rngDB(i).Cells(2, 1).Address
    Next i
End Sub

Sub FindAll(text)

    Dim fnd As String, FirstFound As String
    Dim FoundCell As Range, rng As Range
    Dim myRange As Range, LastCell As Range
    Dim sAddress() As String
    Dim n As Integer
    
    fnd = text
    
    Set myRange = ActiveSheet.UsedRange
    Set LastCell = myRange.Cells(myRange.Cells.Count)
    Set FoundCell = myRange.Find(what:=fnd, after:=LastCell)
    
    'Test to see if anything was found
      If Not FoundCell Is Nothing Then
        FirstFound = FoundCell.Address
      Else
        'GoTo NothingFound
      End If
    
    Set rng = FoundCell
    
    'Loop until cycled through all unique finds
        Do
            n = n + 1
            ReDim Preserve rngDB(1 To n)
            ReDim Preserve sAddress(1 To n)
            Set rngDB(n) = FoundCell.CurrentRegion
            sAddress(n) = rngDB(n).Address
            Set FoundCell = myRange.FindNext(after:=FoundCell)
        
        Loop While FoundCell.Address <> FirstFound
    
    'Creates global value with all found adresses
    If n Then
        Values = Join(sAddress, ",")
    End If
 
End Sub