Redim Preserve горит ошибка «Out of Range» - PullRequest
Новая
       10

Redim Preserve горит ошибка «Out of Range»

0 голосов
/ 11 января 2020

Я хочу создать двумерный массив с 2 фиксированными столбцами и динамическими c строками. Результат должен быть (например): 

(row number) , (row group level)
     3       ,         2
     4       ,         2
     6       ,         3
     7       ,         3
     8       ,         3

Пока у меня есть этот код ниже, который, кажется, работает для первой записи массива, но как только я переименую массив (второй раз), ошибка 9 'Subscript Out of Range' показывает: 

Dim rng As Range: Set rng = Sheet1.UsedRange
Dim rws() As String
Dim n As Integer, r As Integer, FirstRow As Integer, LastRow As Integer, g As Integer
Dim groupLevel() As Long, i As Long

i = 1: ReDim Preserve groupLevel(1 To 1, 1 To 2)

'get rows to look in for grouped rows
rws = Split(Replace(rng.AddressLocal, ":", ""), "$")
FirstRow = rws(2)
LastRow = rws(4)

With rng.Rows
     For r = FirstRow To LastRow
            For g = 2 To 8
                If .Rows(r).OutlineLevel = g Then
                    groupLevel(i, 1) = r
                    groupLevel(i, 2) = .Rows(r).OutlineLevel
                    i = i + 1
                    ReDim Preserve groupLevel(1 To i, 1 To 2)     '<<<<<<<<<<<<<< error 9
                End If
            Next
     Next r
End With

Я не знаю, как это исправить. Что мне здесь не хватает?

Спасибо!

Ответы [ 2 ]

0 голосов
/ 11 января 2020

Большое спасибо ВСЕМ за ваш вклад! очень признателен! Я решил go по предложению Виталия Прушака и сначала получил размеры моего массива, а затем один раз ReDim'ed, который избавляет от головной боли ... 

Dim rng As Range: Set rng = Sheet1.UsedRange
Dim rws() As String
Dim r As Integer, FirstRow As Integer, LastRow As Integer, g As Integer
Dim groupLevel(), RowsCount As Long, i As Long

'get rows to look in for grouped rows
rws = Split(Replace(rng.AddressLocal, ":", ""), "$")
FirstRow = rws(2)
LastRow = rws(4)

'get dimentions for array first ----------------------------------
With rng.Rows
For r = FirstRow To LastRow
    If .Rows(r).OutlineLevel > 1 Then RowsCount = RowsCount + 1
    Next r '------------------------------------------------------

    'set array----------------------------------------------------
    ReDim groupLevel(1 To RowsCount, 1 To 2)
    '-------------------------------------------------------------

    'populate array with rows using a group-----------------------
    i = 1
    For r = FirstRow To LastRow
           For g = 2 To 8
               If .Rows(r).OutlineLevel = g Then
                   groupLevel(i, 1) = r
                   groupLevel(i, 2) = .Rows(r).OutlineLevel
                   i = i + 1
               End If
           Next
    Next r'-------------------------------------------------------

End With

'for debug
For r = 1 To UBound(groupLevel, 1)
        Debug.Print "Row " & groupLevel(r, 1) & vbTab & " GroupLevel [" & groupLevel(r, 2) & "]"
Next r
Debug.Print " ************ end *************"

Одна вещь, которая до сих пор беспокоит меня, это наличие использовать один и тот же For ... Next дважды, один раз, чтобы проверить только уровень контура, превышающий 1, чтобы определить размер массива, и второй раз, чтобы фактически заполнить массив. Существует ли способ обойти это, не так ли? Я спрашиваю, потому что количество строк может сильно различаться (в некоторых случаях дюжина, в других сотни или тысячи ..).

Не будет ли это замедляться при циклическом переключении больших диапазонов? Я также должен был бы применить большую часть того же самого, чтобы проверить и сгруппированные столбцы ..

Спасибо!

0 голосов
/ 11 января 2020

Обходной путь с помощью `Application.Index ()

Дополнительно к действительному комментарию Скотта Крэйнера для применения Application.Transpose() к массиву с измененными размерами строк / столбцов, я демонстрирую подход с использованием Application.Index(). 

Sub test()
    Dim rng As Range: Set rng = Sheet1.UsedRange
    Dim rws() As String
    Dim n As Integer, r As Integer, FirstRow As Integer, LastRow As Integer, g As Integer
    Dim groupLevel() As Variant                                     ' <<<< [0] declare as Variant

    Dim i As Long
    i = 1
    groupLevel = rng                                                ' <<<< [1] assign data to 1-based 2-dim array

    'get rows to look in for grouped rows
    rws = Split(Replace(rng.AddressLocal, ":", ""), "$")
    FirstRow = rws(2)
    LastRow = rws(4)
    With rng.Rows
         For r = FirstRow To LastRow
                For g = 2 To 8
                    If .Rows(r).OutlineLevel = g Then
                        groupLevel(i, 1) = r
                        groupLevel(i, 2) = .Rows(r).OutlineLevel
                        i = i + 1
    ''                    ReDim Preserve groupLevel(1 To i, 1 To 2)  ' [2] delete line <<<<<<<<<<<<<< error 9
                    Else
                        If r = 3 Then
                            groupLevel(i, 1) = r
                            groupLevel(i, 2) = g
                        i = i + 1
                        End If
                    End If
                Next
         Next r
    End With
    '[3] provide for single result or no results
    If i < 2 Then i = 2
    '===================================================
    '[4] use Application.Index for pseudo ReDim Preserve
    '---------------------------------------------------
    groupLevel = Application.Index(groupLevel, Evaluate("row(1:" & i & ")"), Array(1, 2))

'write array to any target
'Sheet2.Range("A2").Resize(UBound(groupLevel), UBound(groupLevel, 2)) = groupLevel

End Sub

Дальнейшая идея

Можно даже присвоить массив с инверсией столбца / строки для свойства listbox'es .List, созданного в пролететь мимо CreateObject("Forms.ListBox.1"), удалить строки и восстановить результат через свойство .Column.

...