如何在循环VBA中创建VBA循环?

时间:2019-03-02 17:57:14

标签: excel vba loops

因此,由于我刚刚开始学习使用VBA进行编写,因此不确定这是否是正确的解决方法。

我创建了一个代码,该代码将遍历我的数据并基本上确定某个状态是否处于特定状态,如果不是,则该状态为“已接收”,实际上该状态将处于另一状态,但是我没有关心那个状态是什么,因为我会自动知道它没有被接收。因此,我只需要简单地知道它是否已收到即可。

我的数据最初以"Status" "Date" "Status" "Date" "Status" "Date"等格式格式化,全部都在一行内。每行将代表一个ID

现在,我的数据集已更改为:

  1. 第一行-"ID" "Status" "Date"
  2. 第二行-"ID" "Status" "Date"

但是,我现在的问题是一个ID可以继续并具有多个状态,因此它可以使用相同的ID连续7行,而另一个可以简单地具有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

样本数据:

1 个答案:

答案 0 :(得分: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