Цикл VBA для добавления строк в массив неправильно перезаписывается?

Question

Я работаю над сабом и застрял на одной и той же проблеме какое-то время и надеялся, что у кого-то есть простое решение!

У меня есть данные в строках, упорядоченных по именам станций (примерно 6 строк (месяцев) на станцию), и, проще говоря, я хотел бы, чтобы для каждого имени станции извлекались соответствующие строки данных в переменную / (массив? ), чтобы позже сделать некоторые вычисления "back end" с помощью.

код, который у меня есть на данный момент:

Sub Electrical_Checks()

Dim a As Integer
Dim i As Integer
Dim ElectricalData As Variant

a = Worksheets("1. Electrical Checks_Yes_No_CFC").Cells(Rows.Count, 1).End(xlUp).Row

' get electrical data per station
For Each Cell In Worksheets("Total Checks").Range("StationNames") 'for each station name in the StationNames dynamic range in Total Checks sheet
c = 0
For i = 1 To a 'if match in Checks sheet, extract row to ElectricalData
    If Worksheets("1. Electrical Checks_Yes_No_CFC").Cells(i, 3) = Cell Then
    c = c + 1
    ElectricalData = Application.Transpose(Worksheets("1. Electrical Checks_Yes_No_CFC").Rows(i).Columns("A:T")) 'transpose to make ReDim Preserve work

    ReDim Preserve ElectricalData(1 To 20, 1 To c) 'add new column

    End If
Next i
Debug.Print ElectricalData 'my inelegant way to bring up an error to check in locals window

Next Cell

End Sub

Так что для меня это выглядит как вложенный цикл for (для каждой станции, для каждой линии), занимая всего одну станцию, я перебрал лист «Электрические проверки», чтобы найти строки, содержащие название станции, «extract» соответствующая строка, где есть совпадение, и когда новая строка найдена, я попытался использовать transpose и ReDim Preserve, чтобы добавить новую транспонированную строку в массив ElectricalData - это дает двумерный массив с 20 строками и 6 столбцами (столбец в месяц)

Однако на каждой итерации i я обнаружил, что данные извлекаются нормально, но перезаписывают первый столбец, а не сохраняют его в массиве, например, как показано ниже: неправильно сохраненные данные

где значение 0.310018 определенно является параметром последнего месяца. Когда я нажимаю F8 в сценарии, количество столбцов в ElectricalData увеличивается на 1, но опять же данные всегда сохраняются в первом столбце, а не перемещаются. Если у кого-то есть идеи, почему пустые столбцы остаются пустыми (я неправильно использую ReDim Preserve?), Я был бы очень благодарен!

Большое спасибо, C

Answer 1

Примерно так:

Sub Electrical_Checks()

    Dim a As Long
    Dim i As Long

    Dim ElectricalData() As Variant, shtECYN As Worksheet
    Dim d, n As Long, m As Long, Cell, c As Long

    Set shtECYN = Worksheets("1. Electrical Checks_Yes_No_CFC")

    a = shtECYN.Cells(Rows.Count, 1).End(xlUp).Row

    ' get electrical data per station
    'for each station name in the StationNames dynamic range in Total Checks sheet
    For Each Cell In Worksheets("Total Checks").Range("StationNames")

        'how many matching lines?
        n = Application.CountIf(shtECYN.Cells(i, 3).Resize(a, 1), Cell.Value)
        ReDim Preserve ElectricalData(1 To 20, 1 To n) '<<< size the array to match
        c = 0
        For i = 1 To a 'if match in Checks sheet, extract row to ElectricalData
            If shtECYN.Cells(i, 3) = Cell.Value Then
                c = c + 1
                d = shtECYN.Rows(i).Columns("A:T")
                For m = 1 To UBound(d, 2)
                    ElectricalData(m, c) = d(1, m)
                Next m
            End If
        Next i
        'check the array content (for debugging purposes)
        Sheets("test").Range("A1").Resize(20, n).Value = ElectricalData
    Next Cell

End Sub