Переназначение массива диапазонов в один массив, содержащий только значения каждого элемента диапазона

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.Что я хочу закончить после того, как вложенный цикл - это массив, содержащий элементы всех диапазонов в одном массиве с одним измерением.

Причина, по которой я хочу это в конце, в том, что я хочу создать диаграмму, используя значения массива.

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

Вы можете использовать следующее, чтобы объединить все массивы в один

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

Answer 3

Это должно работать для вас:

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