当它返回原始Range对象而不是collection时，从Range.Area方法提取/拆分多个范围吗? [英] Extract/Split multiple ranges from Range.Area method when it returns original Range object instead of collection?

问题描述

在编写以下内容时，我忽略了一个明显的案例场景，希望这里的专家可以阐明下一步应该如何恢复该代码...

I overlooked an obvious case scenario while writing the following, and am hoping the experts here can shed light on what path I should go down next to recover this code...

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

摘自Microsoft文档:

From Microsoft documentation:

对于单个选择，Areas属性返回一个包含一个对象(原始Range对象本身)的集合.对于多区域选择，区域"属性返回一个集合，其中每个选定区域都包含一个对象.

For a single selection, the Areas property returns a collection that contains one object—the original Range object itself. For a multiple-area selection, the Areas property returns a collection that contains one object for each selected area.

其中存在一个问题:我假设Areas属性始终将每一行作为Area 对象返回，但是事后看来，如果它们是连续范围，则默认情况下会加入Areas.

Therein is the problem: I assumed Areas property would always return each row as an Area object, but in hindsight it makes sense that it would join the Areas by default if they are contiguous ranges.

总体目标是在刷新工作簿数据之前存储用户放置在列中的所有注释.刷新后，它将循环遍历数组，并将注释放回匹配的条目中.我以前使用(存储)隐藏的帮助程序工作表，但想使用数组代替所有明显的好处.在事后看来，我最初只假设不连续的音符行的假设是一个可怕的假设.尽管工作簿绝对具有不连续的注释，但它也可以连续存在，并且很可能包含这两个注释，从而使 noterange 返回一个区域的组合，其中一些区域是我想要的单个行，但是其他区域是连续的行，需要以某种方式进行拆分才能与我的设计一起使用.

The overall goal is to store any notes the user placed in a column before refreshing the workbook data. Once refreshed, it loops through the array and places the notes back into matching entries. I was using hidden helper worksheets (to store) previously but wanted to use arrays instead for all the obvious benefits. My initial assumption of only non-contiguous note rows was admittedly a terrible assumption in hindsight. While the workbook will absolutely have non-contiguous notes, it could also have them contiguous, and will most likely contain both, making noterange return a combination of areas where some areas are individual rows as I want them, but other areas are contiguous rows that need to be split somehow to work with my design.

那么是否可以采用连续范围，然后将其拆分为组件行?例如，范围对象 noterange.Address 返回连续的:

So is it possible to take a contiguous range and then split it into component rows? For example, the range object noterange.Address returns contiguous:

$A$4:$G$6

但是我认为它会作为一个集合返回(在阅读Range.Areas文档之前)

But I assumed it would return as a collection (before reading the documentation for Range.Areas)

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

包含N = 3个区域.(仅举一个例子，实际上N是大约14万行，可能在note列中包含一个值.)

containing N = 3 areas. (just as an example, in practice N is ~ 140K rows that might potentially contain a value in the note column.)

要清楚，实际的VBA错误在这里出现 mainnotes(i，areaNum)= acell.Value ，因为如果Area包含多行，则单元格数(或 i)超出数组定义的范围.如果没有连续的行，那么一切都会很好，然后将每行视为一个单独的区域.

To be clear, the actual VBA error occurs here mainnotes(i, areaNum) = acell.Value because if an Area contains more than one row, the number of cells (or i) then exceeds the bounds of the array definition. Everything works great if there are no contiguous rows, where it then treats each row as a separate area.

在输入时，希望我的潜意识能够解决它.但是我觉得我已经达到了这一极限，并且很高兴能朝着正确的方向前进！

In typing this out, hopefully my subconscious begins to solve it. But I feel I've reached my limit of knowledge on this and would appreciate being steered in the right direction!

推荐答案

对 BigBen 的贡献，在他的评论中提供了必要的线索，并向我介绍了 .CountLarge 他随后删除了一个答案.

Huge credit to BigBen for providing the necessary clues in his comments and introducing me to .CountLarge in an Answer he subsequently deleted.

我实现了他的大部分建议(尽管专栏#仍然是硬编码的):

I implemented most of his suggestions (though column# still hard-coded):

1. 使用行/列的标准做法(而非相反)为数组确定尺寸.
2. 使用 noterange.Cells.CountLarge/(列数)为数组确定尺寸，以获取 actual 实际存在的行数，而不是使用Areas数(因为在这种情况下某些区域将包含多行.)
3. 依次遍历每个 Range.Area ，然后依次遍历该 Range.Area 中的每个 Row ，然后遍历每个 Cell >在该 Row 中，将 Range.Value 分配给它在数组中的位置.

1. Dimensioned the array using standard practice of rows/columns instead of the reverse.
2. Dimensioned the array using noterange.Cells.CountLarge / (# of columns) to get actual number of rows that will exist, rather than using the number of Areas (because some areas will contain more than one row in this scenario.)
3. Iterated through each Range.Area, then each Row within that Range.Area, then through each Cell within that Row, assigning the Range.Value to it's position within the array.

这是最终代码，无论注释列中的注释配置如何，该代码均有效:

Here is the final code which works no matter what the configuration of the Notes are in the note column:

'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提供建议和摘要！

Thank you to BigBen for the suggestions and snippet!

这篇关于当它返回原始Range对象而不是collection时，从Range.Area方法提取/拆分多个范围吗?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！