Как создать цикл VBA внутри цикла VBA?

Question

Так что не уверен, что это правильный путь, потому что я только начинаю учиться писать на VBA.

Я создал код, который будет циклически проходить по моим данным и в основном обнаруживать, находился ли статус в определенном состоянии, который был «Получен», если нет, по сути он находился бы в другом состоянии, но яМне было все равно, что это за статус, потому что я автоматически узнаю, что он не был получен.Итак, мне нужно было просто знать, получено это или нет.

Мои данные изначально были отформатированы таким образом, чтобы они были "Status" "Date" "Status" "Date" "Status" "Date" и т. Д., Все в одной строке.Каждая строка будет представлять один ID.

Теперь мой набор данных изменился на:

1. 1-й ряд - "ID" "Status" "Date"
2. 2-й ряд - "ID" "Status" "Date"

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

Теперь, я немного запутался, как это будет работать с циклами?Есть ли способ представить каждого отдельного ID и сделать так, чтобы цикл «только цикл» проходил через количество строк, с которыми ID связан с ними?

Вот мой оригинальный код:

Sub CheckDates()
    Dim count As Integer
    Dim i As Integer
    Dim j As Integer

    Sheets(1).Select

    lastrow = ActiveSheet.Cells(Rows.count, "B").End(xlUp).Row

    'have to keep data in a table for this to actually work as it ctrls+left to the table, which will end where the very last text of any row is
    lastcolumn = ActiveSheet.Cells(3, Columns.count).End(xlToLeft).Column

    count = 0
    i = 4
    j = lastcolumn

    For i = 4 To lastrow
        For j = lastcolumn To 6 Step (-1)
            If Sheet1.Cells(i, j) < Sheet2.Cells(1, 1) And Sheet1.Cells(i, j - 1) = "Reçu" Then
                count = count + 1
                Cells(i, 1).Interior.ColorIndex = 6
                GoTo NextIteration
            End If
        Next j
NextIteration:
    Next i

    Sheet2.Cells(1, 7) = count

    Sheets(2).Select

    'Runs the DeleteSAC Macro
    Call DeleteSAC
End Sub

---

Пример данных:

Answer 1

Работа с рабочими листами всегда медленная, работа с массивами ускорит ваше время и позволит вам делать лучше.

Здесь я использовал 3 массива, 1 для исходных данных и еще 2 в зависимости от состояния, когдаэтот фрагмент кода завершается, у вас есть 2 массива с целыми данными, которые вам нужны для каждого.Тогда вы можете делать все, что захотите.Надеюсь, что это поможет, если вам нужно что-то уточнить, дайте мне знать.

    Sub CheckDates()

        Dim arrData, arrRecieved, arrNotRecieved, countRecieved As Long, countNotRecieved As Long
        Dim wb As Workbook, ws As Worksheet
        Dim i As Long, j As Long, x As Long, z As Long

        Set wb = ThisWorkbook
        Set ws = wb.Sheets("Data") 'where your data is stored

        countRecieved = Application.CountIf(ws.Range("B:B"), "Recieved") 'how many items have Recieved status
        countNotRecieved = Application.CountIf(ws.Range("B:B"), "<>Recieved") 'how many items don't have Recieved status

        arrData = ws.UsedRange.Value 'we put all the data inside of one array

        ReDim arrRecieved(1 To countRecieved, 1 To UBound(arrData, 2)) 'we redimension the array recieved to fit your data
        ReDim arrNotRecieved(1 To countNotRecieved, 1 To UBound(arrData, 2)) 'we redimension the array not recieved to fit your data

        x = 1
        z = 1
        For i = 2 To UBound(arrData) 'let's say you got headers on row 1 so we start on row 2
            If arrData(i, 2) = "Recieved" Then 'If the status is not on the column 2 change this
                For j = 1 To UBound(arrData, 2)
                    arrRecieved(x, j) = arrData(i, j) 'if it's recieved we put it on the recieved array
                Next j
                x = x + 1 'add 1 position to the array
            Else
                For j = 1 To UBound(arrData, 2)
                    arrNotRecieved(z, j) = arrData(i, j) 'if it's not received we put it on the not recieved array
                Next j
                z = z + 1 'add 1 position on the array
            End If
        Next i

        'Now you got 2 arrays, 1 with all the recieved status and the other one with the not recieved status and you can do whatever you want with them

End Sub