时间戳

首页 > 解决方案 > 当返回原始 Range 对象而不是集合时，从 Range.Area 方法中提取/拆分多个范围？

excel - 当返回原始 Range 对象而不是集合时，从 Range.Area 方法中提取/拆分多个范围？

问题描述

在编写以下内容时，我忽略了一个明显的案例场景，希望这里的专家能够阐明我接下来应该走哪条路来恢复这段代码......

If Application.counta(wurgtbl.DataBodyRange.Columns(7)) > 0 Then 'checks if Note column contains any

    wurgtbl.DataBodyRange.AutoFilter Field:=7, Criteria1:="=*"  'uses autofilter to show only rows with a note

    Dim noterange As Range 'store note row addresses in range, each row (was supposed to) be treated as separate area
    Set noterange = wurgtbl.DataBodyRange.SpecialCells(xlCellTypeVisible)

    'oops, this only works if 100% discontinuous (multiple selection) ranges.  when any contiguous rows have a note,
    'their ranges are treated as a single selection which breaks my assumption of each row being a separate area!  
    'I had initially spaced my test notes out on different rows and it only broke when testing two contiguous notes

    'add range to array: since discontinuous range is certain, cant mainnotes = noterange.Value, must loop instead
    Dim mainnotes() As String
    ReDim mainnotes(0 To 6, 0 To noterange.Areas.Count - 1)
    Dim area As Range 'each group (area) will get its own row in array
    Dim acell As Range 'this will be each actual cell in the sub-groups
    Dim areaNum As Long

    areaNum = 0
    For Each area In noterange.Areas
        i = 0
        For Each acell In area
            mainnotes(i, areaNum) = acell.Value
            i = i + 1
        Next acell
        areaNum = areaNum + 1
    Next
End If

来自微软文档：

对于单个选择，Areas 属性返回一个包含一个对象的集合——原始 Range 对象本身。对于多区域选择，Areas 属性返回一个集合，该集合包含每个选定区域的一个对象。

这就是问题所在：我假设 Areas 属性总是将每一行作为一个 Area object返回，但事后看来，如果它们是连续的范围，它将默认加入 Areas 是有道理的。

总体目标是在刷新工作簿数据之前存储用户放置在列中的所有注释。刷新后，它会循环遍历数组并将注释放回匹配的条目中。我以前使用隐藏的辅助工作表（存储），但想使用数组来代替所有明显的好处。事后看来，我最初只假设不连续的注释行是一个可怕的假设。虽然工作簿绝对会有不连续的注释，但它也可以让它们连续，并且很可能同时包含两者，从而noterange返回一些区域的组合，其中一些区域是我想要的单独行，但其他区域是需要的连续行以某种方式拆分以配合我的设计。

那么是否可以取一个连续的范围，然后将其拆分为组件行？例如，范围对象noterange.Address返回连续的：

$A$4:$G$6

但我认为它会作为一个集合返回（在阅读 Range.Areas 的文档之前）

$A$4:$G$4,$A$5:$G$5,$A$6:$G$6

包含 N = 3 个区域。（仅作为示例，实际上 N 是 ~ 140K 行，可能包含注释列中的值。）

需要明确的是，实际的 VBA 错误发生在此处，mainnotes(i, areaNum) = acell.Value因为如果一个区域包含多于一行，则单元格（或i）的数量超出了数组定义的范围。如果没有连续的行，一切都会很好，然后它将每一行视为一个单独的区域。

在打字时，希望我的潜意识开始解决它。但我觉得我已经达到了我在这方面的知识极限，希望能被引导到正确的方向！

标签： excelvbarange

解决方案

非常感谢 BigBen在他的评论中提供了必要的线索，并.CountLarge在他随后删除的答案中向我介绍了我。

我实现了他的大部分建议（尽管 column# 仍然是硬编码的）：

  1. 使用行/列的标准做法而不是相反的方式对数组进行标注。
  2. noterange.Cells.CountLarge / (# of columns)使用来获得将存在的实际行数，而不是使用区域数对数组进行标注（因为在这种情况下，某些区域将包含多于一行。）
  3. 遍历 each Range.Area，然后遍历Rowthat Range.Area，然后遍历Cellthat中的 each Row，将 分配Range.Value给它在数组中的位置。

无论注释列中注释的配置如何，这是最终的代码：

'check if notes exist in note column
If Application.counta(wurgtbl.DataBodyRange.Columns(7)) > 0 Then 

    'use autofilter to show only rows with a note
    wurgtbl.DataBodyRange.AutoFilter Field:=7, Criteria1:="=*"  

    'store visible addresses in range
    Dim noterange As Range 
    Set noterange = wurgtbl.DataBodyRange.SpecialCells(xlCellTypeVisible)

    'add range to array: since discontinuous range is certain, cant mainnotes = noterange.Value, must loop instead
    Dim mainnotes() As String
    ReDim mainnotes(0 To noterange.Cells.CountLarge / 7 - 1, 0 To 6) 'Credit to BigBen on SO for this (rows/columns)

    Dim areaiterate As Long
    Dim rowNumb As Long
    Dim colNumb as Long
    Dim arow As Range
    Dim rcell As Range

    rowNumb = 0
    For areaiterate = 1 To noterange.Areas.Count
        For Each arow In noterange.Areas(areaiterate).Rows
            colNumb = 0
            For Each rcell In arow.Cells
                mainnotes(rowNumb, colNumb) = rcell.Value
                colNumb = colNumb + 1
            Next
            rowNumb = rowNumb + 1
        Next arow
    Next areaiterate
End If

感谢 BigBen 的建议和片段！

推荐阅读