Question

我有多个具有范围的工作表，这些工作表收集到一个范围数组中，并且我不能做Union，因为它不能跨工作表工作。由于我想创建一个图表，其中时间序列或FullSeriesCollection基于合并范围的元素，因此我认为将范围数组重新划分为单个数组可能是我的解决方案。也许有一个我看不到的更简单的解决方案。

我试图在下面概述一般情况。范围在我的代码中是动态的，但是在这里我只是随意设置它们。

Sub Collection()

Dim arrDate() As Variant
Dim arrRngTotal As Variant
Dim rng_1 As Range, rng_2 As Range, rng_3 As Range
Dim ws_1 As Worksheet, ws_2 As Worksheet
Dim j As Integer, k As Integer

Set ws_1 = ThisWorkbook.Sheets(1)
Set ws_2 = ThisWorkbook.Sheets(2)
' Example of ranges, not static in the original code.
Set rng_1 = ws_1.Range("A2:A10")
Set rng_2 = ws_1.Range("A11:A22")
Set rng_3 = ws_2.Range("A2:A22")

arrRngTotal = Array(rng_1.Value, rng_2.Value, rng_3.Value)


For k = LBound(arrRngTotal, 1) To UBound(arrRngTotal, 1)
    For j = LBound(arrRngTotal(k), 1) To UBound(arrRngTotal(k), 1)
            ReDim Preserve arrDate(j)
            arrDate(j) = arrRngTotal(k)(j, 1)
    Next j
Next k

End Sub

使用此代码时，我得到一个包含22个元素的数组，它们对应于rng_3的范围。在嵌套循环之后，我想要得到的最终结果是一个数组，其中包含1个维度为1的单个数组中所有范围的元素。

我最终想要这样做的原因是我想使用数组值创建图表。

Answer 1

您的代码很好，唯一的错误是您正在重用内部循环中的同一变量，该变量将在每个外部循环上重置。要解决此问题，只需使用其他变量，例如：

Sub Collection()

Dim arrDate() As Variant
Dim arrRngTotal As Variant
Dim rng_1 As Range, rng_2 As Range, rng_3 As Range
Dim ws_1 As Worksheet, ws_2 As Worksheet
Dim j As Integer, k As Integer, X As Long

Set ws_1 = ThisWorkbook.Sheets(1)
Set ws_2 = ThisWorkbook.Sheets(2)
' Example of ranges, not static in the original code.
Set rng_1 = ws_1.Range("A2:A10")
Set rng_2 = ws_1.Range("A11:A22")
Set rng_3 = ws_2.Range("A2:A22")

arrRngTotal = Array(rng_1.Value, rng_2.Value, rng_3.Value)


For k = LBound(arrRngTotal, 1) To UBound(arrRngTotal, 1)
    For j = LBound(arrRngTotal(k), 1) To UBound(arrRngTotal(k), 1)
            X = X + 1                       'Add an additional counter
            ReDim Preserve arrDate(X)
            arrDate(X) = arrRngTotal(k)(j, 1)
    Next j
Next k

End Sub

编辑：略有不同，以根据@Tom建议提高速度...更多详细信息，请参见评论。

Sub Collection()

Dim arrDate() As Variant: ReDim arrDate(1 To 1)
Dim arrRngTotal As Variant
Dim rng_1 As Range, rng_2 As Range, rng_3 As Range
Dim ws_1 As Worksheet, ws_2 As Worksheet
Dim j As Integer, k As Integer, X As Long

Set ws_1 = ThisWorkbook.Sheets(1)
Set ws_2 = ThisWorkbook.Sheets(1)
' Example of ranges, not static in the original code.
Set rng_1 = ws_1.Range("A2:A10")
Set rng_2 = ws_1.Range("A11:A22")
Set rng_3 = ws_2.Range("A2:A22")

arrRngTotal = Array(rng_1.Value, rng_2.Value, rng_3.Value)

'Dimension the holding array outside the main data loop, unless you need to do this inside based on various conditions
For k = LBound(arrRngTotal, 1) To UBound(arrRngTotal, 1)
    X = X + UBound(arrRngTotal(k))
Next k
ReDim Preserve arrDate(1 To X): X = 0

For k = LBound(arrRngTotal, 1) To UBound(arrRngTotal, 1)
    For j = LBound(arrRngTotal(k), 1) To UBound(arrRngTotal(k), 1)
            X = X + 1
            arrDate(X) = arrRngTotal(k)(j, 1)
    Next j
Next k

End Sub

Answer 2

这应该对您有用：

Option Explicit
Sub Collection()

    Dim arrDate As Variant
    Dim ws_1 As Worksheet, ws_2 As Worksheet
    Dim LastRow As Long, j As Long

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    Set ws_1 = ThisWorkbook.Sheets(1)
    Set ws_2 = ThisWorkbook.Sheets(2)


    With ThisWorkbook
        .Sheets.Add After:=.Sheets(.Sheets.Count)
    End With
    With ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        .Range("A1").Resize(ws_1.Range("A2:A10").Rows) = ws_1.Range("A2:A10").Value
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        .Range("A" & LastRow).Resize(ws_1.Range("A11:A22").Rows) = ws_1.Range("A11:A22").Value
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        .Range("A" & LastRow).Resize(ws_2.Range("A2:A22").Rows) = ws_2.Range("A2:A22").Value
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        j = 1
        ReDim arrDate(1 To LastRow)
        For Each C In .Range("A1:A" & LastRow)
            arrDate(j) = C
        Next C
        .Delete
    End With

    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With

End Sub

Answer 3

您可以使用以下命令将所有数组组合为一个

Sub Collection()

    Dim arrDate() As Variant
    Dim arrRngTotal As Variant
    Dim rng_1 As Range, rng_2 As Range, rng_3 As Range
    Dim ws_1 As Worksheet, ws_2 As Worksheet
    Dim j As Long, k As Long, arrCounter As Long

    Set ws_1 = ThisWorkbook.Sheets(1)
    Set ws_2 = ThisWorkbook.Sheets(2)

    ' Example of ranges, not static in the original code.
    Set rng_1 = ws_1.Range("A2:A10")
    Set rng_2 = ws_1.Range("A11:A22")
    Set rng_3 = ws_2.Range("A2:A22")

    With Application
        arrRngTotal = Array(.Transpose(rng_1.Value), .Transpose(rng_2.Value), .Transpose(rng_3.Value))
    End With

    For k = LBound(arrRngTotal) To UBound(arrRngTotal)
        On Error Resume Next
        arrCounter = IIf(IsNumeric(UBound(arrDate)), UBound(arrDate), 0)
        arrCounter = arrCounter + GetArraySize(arrRngTotal(k))
        On Error GoTo 0
        ReDim Preserve arrDate(1 To arrCounter)

        For j = LBound(arrRngTotal(k)) To UBound(arrRngTotal(k))
            Debug.Print UBound(arrDate) - (UBound(arrRngTotal(k)) - j), arrRngTotal(k)(j)
            arrDate(UBound(arrDate) - (UBound(arrRngTotal(k)) - j)) = arrRngTotal(k)(j)
        Next j
    Next k

End Sub

Private Function GetArraySize(arr As Variant) As Long
    GetArraySize = UBound(arr) - LBound(arr) + 1
End Function

将范围数组重新定义为仅包含每个范围元素的值的单个数组

3 个答案: