Как изменить размер одномерного массива VBA с помощью Redim

Question

Я пытаюсь изменить размер массива Dynami c (Sub rangearray) с новыми значениями после проверки, есть ли какие-либо значения в исходном массиве> 590. Массив представляет собой одномерный столбец с диапазоном цифр, как показано ниже, всего 1 столбец и несколько строк.

Я пробовал множество возможных решений, но, похоже, ни одно из них не работает. Я могу наблюдать в окне Locals, хотя это одномерный массив, он кажется двухмерным с (1 to 5, 1 to 1), и мне удалось получить 620 и 630 в окне сообщения, и я попытался воспроизвести этот код для рабочего листа, но я постоянно получил индекс за пределами допустимого диапазона.

Я был бы признателен, если бы кто-нибудь мог сообщить мне, что мне нужно сделать, чтобы изменить размер массива (скопированного на лист) только с новыми значениями, а не с предыдущими значениями, а также объяснить размер одноразмерного и кратного массива измерений. Я знаю, что с Redim вы можете изменить только второе измерение, и вот где я немного запутался, одно измерение ниже имеет два измерения или одно кажется двумя, иначе у него будет только одно измерение, которое должно облегчить изменение размера .

Решение, которое работает, но только окно сообщения не рабочий лист

For i = 1 To 5
    For j = 1 To 1
        If arr(i, j) > 590 Then
            MsgBox arr(i, j)
        End If
    Next j
Next i

Набор данных

590
590
590
620
630

Массив, который не работает, ниже вставьте значение из массива с измененным размером в рабочий лист

Sub rangearray()
    Dim arr() As Variant
    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim i As Variant
    Dim ws2 As Workbook

    Set ws2 = Workbooks("PRA.XLSM")
    Set ws = Workbooks("PRA.XLSM").Worksheets("Rec")
    Set ws1 = Workbooks("PRA.XLSM").Worksheets("CPT")

    arr() = ws.Range("a4:a15").Value

    For Each i In arr
        If i > 590 Then
            ReDim arr(i)
            arr(i) = i
        End If
    Next i

    ws1.Range("A4:A15").Value = WorksheetFunction.Transpose(arr)
End Sub

Answer 1

Попробуйте,

Sub rangearray()
    Dim arr() As Variant
    Dim a() As Variant
    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim i As Long
    Dim ws2 As Workbook
    Dim n As Long

    Set ws2 = Workbooks("PRA.XLSM")
    Set ws = Workbooks("PRA.XLSM").Worksheets("Rec")
    Set ws1 = Workbooks("PRA.XLSM").Worksheets("CPT")

    arr() = ws.Range("a4:a15").Value

    For i = 1 To UBound(arr, 1)
        If arr(i, 1) > 590 Then
            n = n + 1
            ReDim Preserve a(1 To n)
            a(n) = i
            'a(n) = i + 3 'If you need the cell's row number,
        End If
    Next i

    ws1.Range("A4").Resize(n) = WorksheetFunction.Transpose(a)
End Sub

Answer 2

1. Ваш массив, который будет обработан, является типом 2D-массива. Вам не нужен (только) одномерный массив, чтобы выполнить sh то, что вы хотите, но если это ваш wi sh, это можно сделать с помощью другого массива (в данном случае 1D, но также может быть и 2D) .

2. Redim можно использовать для любого массива Dim без указания размеров. Redim Preserve можно использовать только для второго измерения, а это означает изменение второго, но с сохранением значений.

3. Пожалуйста, используйте этот код для выполнения sh чего (я понял) вы хотели:

    Dim arr() As Variant, ws As Worksheet, ws1 As Worksheet, i As Long
    Dim arrF As Variant, k As Long
    
    Set ws = Workbooks("PRA.XLSM").Worksheets("Rec")
    Set ws1 = Workbooks("PRA.XLSM").Worksheets("CPT")

    arr() = ws.Range("a4:a15").Value
    ReDim arrF(UBound(arr))

    For i = 1 To UBound(arr)
        If arr(i, 1) < 590 Then
            arrF(k) = arr(i, 1): k = k + 1
        End If
    Next i
    ReDim Preserve arrF(k - 1)
    ws1.Range("A4").Resize(UBound(arrF) + 1, 1).Value = WorksheetFunction.Transpose(arrF)
End Sub

Что, я думаю, полезно знать, вы также можете использовать 2D (новый) массив. В таком случае вам нужно было Redim таким образом:

ReDim arrF(1 To 1, 1 To UBound(arr))' the rows and columns are reversed, only to allow Redim Preserve (for the last dimension), after the loop where it was load

Он должен быть загружен (как 2D-массив) таким образом:

arrF(1, k) = arr(i, 1)

И Resize следует адаптировать к 2D-массиву:

ws1.Range("A4").Resize(UBound(arrF, 2), 1).Value

Transpose сохраняется, но только для транспонирования строк в столбцы ...

Answer 3

• Прежде всего, когда вы копируете значения диапазона (нескольких ячеек) в Variant, вы всегда получаете двумерный массив. Например,

Dim arr As Variant
arr = Range("A1:A5")

означает, что arr - это двумерный массив, аналогичный arr(1 to 5, 1 to 1) (т.е. 5 строк и 1 столбец)

• Если вы хотите получить одномерный массив, вы можете использовать функцию Transpose листа

Dim arr as Variant
arr = WorksheetFunction.Transpose(Range("A1:A5"))

Теперь это похоже на arr(1 to 5)

Я не понимаю, что вы делаете в л oop. Например, когда вы находите значение i > 590 (например, 600), вы изменяете размер массива до 600 элементов. Это то, что вы хотите? Более того, вы не придерживаетесь никаких ценностей. For each i in arr дает i значения элементов вашего arry (не индекс), поэтому выполнение чего-то вроде arr(i) = i присваивает значение i элементу i th (это то, что вы пытаетесь для достижения?)

У меня сложилось впечатление, все, что вам нужно, это изменить значения этих элементов > 590, и для этого вам не нужно Redim: вы просто меняете значение.

Если вы можете объяснить, чего именно вы пытаетесь достичь, я (или кто-то другой) смогу вам помочь.

Редактировать (Ответ) :

Вот два из многих способов достижения желаемого:

1. Самый простой способ - использовать функцию Filter() листа. В целевом диапазоне введите формулу массива

=FILTER(Rec!$A$4:$A$15,Rec!$A$4:$A$15>590)

1. Создайте массив для хранения отфильтрованных значений (я думаю, это тот подход, который вы предпочитаете)

Sub rangearray()
    Dim vInput As Variant
    Dim arrOutput() As Variant
    Dim v As Variant
    Dim lOutElems As Long:  lOutElems = 0
    Dim wb As Workbook:     Set wb = ThisWorkbook ' Workbooks("PRA.XLSM")
    Dim ws As Worksheet:    Set ws = wb.Worksheets("Rec")
    Dim ws1 As Worksheet:   Set ws1 = wb.Worksheets("CPT")
    
    vInput = ws.Range(ws.Range("A4"), ws.Range("A" & Rows.count).End(xlUp)).Value
    'vInput = ws.Range("a4:a15").Value ' or hardcoded
    
    For Each v In vInput
        If v > 590 Then
            lOutElems = lOutElems + 1
            ReDim Preserve arrOutput(1 To lOutElems)
            arrOutput(lOutElems) = v
        End If
    Next v

    ws1.Range("A4").Resize(lOutElems, 1).Value = WorksheetFunction.Transpose(arrOutput)
End Sub

• Другой подход - использовать автофильтр (в листе Excel или в VBA). Вы также можете использовать функцию Filter() рабочего листа в VBA. Выбор за вами.

Answer 4

Объявите новую переменную с именем value (одномерный массив), после условия проверки используйте комбинацию redim preserve с worksheetfunction.transpose:

Вот пример кода:

Sub rangearray()
Dim value()
ReDim value(1 To 15 - 4 + 1)
arr = Range("a4:a15").value
Dim i As Integer
i = 1
    For Each cell In arr
         If cell > 590 Then
            value(i) = cell
            i = i + 1
        End If
    Next
 ReDim Preserve value(1 To i - 1)
 Range("A4:A15").Clear 'clear contents before write new values
 Range("A4:A15").Resize(i - 1, 1).value = WorksheetFunction.Transpose(value)
End Sub

Answer 5

Вы можете прочитать значения одного столбца в одномерном массиве, используя WorksheetFunction.Transpose дважды. Например, у вас есть столбец с данными, начинающимися с ячейки A1. Затем вы можете заполнить одномерный массив следующим образом:

Sub ch()
 Dim arr()
 Dim nRows As Integer
 nRows = Sheet1.Range("A1").End(xlDown).Row
 ReDim arr(1 To nRows)
 arr = WorksheetFunction.Transpose(WorksheetFunction.Transpose(Sheet1.Range("A1").Resize(nRows, 1)))
End Sub