VBA数组故障错误9脚本超出范围

Question

谢谢你阅读我的问题，

我收到了一份约250 000条条目的列表，以及姓名和签名日期，以便在每一项记录时显示出来。我的任务是找出哪些用户连续几天登录，多久一次，多少次。

即鲍勃·史密斯连续3天一次，连续5天3次。乔史密斯连续8天一次，连续5天8次等。

我是一个全新的VBA，一直在努力编写一个程序来完成这个任务。代码：

Option Explicit

Option Base 1

Sub CountUUIDLoop()

    Dim UUID As String
    Dim Day As Date
    Dim Instance() As Variant
    ReDim Instance(50, 50)
    Dim CountUUID As Variant
    Dim q As Integer
    Dim i As Long
    Dim j As Long
    Dim f As Integer
    Dim g As Integer
    Dim LastRow As String
    f = 1
    q = 1
    g = 2

        LastRow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
        For i = q To LastRow
            UUID = Cells(i, "A")
            Instance(f, 1) = UUID

            g = 2
            For j = 1 To LastRow
                If UUID = Cells(j, "A") Then
                    Instance(f, g) = Cells(j, "B")
                    g = g + 1
                End If

            Next j
            f = f + 1
            q = g - 1
        Next i

End Sub

这段代码的目标是遍历条目并将它们存储在数组‘实例’中，使2D数组看起来像UUID1、B1、B2、B3 UUID3、B1、B2

在UUID是用户的情况下，B1表示用户登录的日期，b2将是他们登录的下一个日期等等。有些用户的日期比其他用户多或少。

我的主要问题是设置数组，因为我总是在它周围出现不同的错误。我不知道如何定义这个2D数组，部分原因是会有超过30000行，每一行都有1->85列。

如果有什么需要进一步澄清的话，请告诉我。再一次，这是我第一次使用VBA，所以如果我做的一切都是错误的，我很抱歉。

我使用ReDim实例(50,50)作为测试，看看是否可以通过预定义使其工作，但也发生了相同的错误。再次感谢！

Answer 1

据我从您的问题和代码中了解到，您有一个具有以下结构的表：

..............A.................B

1........LOGIN1.......DATE1

2........LOGIN1.......DATE2

3........LOGIN1.......DATE3

4........LOGIN2.......DATE4

5........LOGIN2.......DATE5

6........LOGIN3.......DATE6

在这段代码中，您的任务是在如下的2D结构中获取数据：

结果阵列-

.-LOGIN1 1-

............................................|-DATE1

............................................|-DATE2

............................................|-DATE3

.-LOGIN2 2-

............................................|-DATE4

............................................|-DATE5

.-LOGIN3 3-

............................................|-DATE6

首先，您需要知道代码中出现了什么问题。请参阅下面代码中的注释，找出错误的原因：

Option Explicit

Option Base 1

Sub CountUUIDLoop()

    Dim UUID As String
    Dim Day As Date
    Dim Instance() As Variant ' If you are using variant data type, it is not necesary to point it: default data type in VBA is Variant. Just write like this: "Dim Instance()"
    ReDim Instance(50, 50) ' Limitation in 50 may be the reason, why your script is going into "out of range" error.
                           ' Remember, that this operation means, that your array now will have following dimentions: [1..50,1..50]
    Dim CountUUID As Variant 'Just write like this: "Dim CountUUID"
    Dim q As Integer ' you can describe all your variables in one line, like this: "Dim q as Integer,f as Integer,g as Integer"
    Dim i As Long
    Dim j As Long
    Dim f As Integer
    Dim g As Integer
    Dim LastRow As String ' first mistake: you are using String data type to perform numeric operations below in your FOR-cycle
    f = 1 ' Your Instance array index starts from {0} and you are not using this index by starting from {1}.
    q = 1 ' The reason to use this variable is not obvious. You could just use constant in FOR cycle below and avoid unnecessary variables.
    g = 2 ' You could remove this line, because this var is set every time in cycle below (before second FOR)

        LastRow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row ' The alternative here is to use predefined Excel constants, like this:
                                                                      ' "Cells.SpecialCells(xlLastCell).Row".
        'If LastRow is bigger, than {50} - this could be a reason of your Error.
        For i = q To LastRow  ' Here goes comparison between String and Integer data type, not good thing, but type conversion should work fine here.
            UUID = Cells(i, "A") ' No need to perform re-set here, just move forward and assign value from this cell to the Instanse directly:
                                 ' Like this: Instance(f, 1) = Cells(i, "A")
            Instance(f, 1) = UUID

            g = 2
            For j = 1 To LastRow ' It is another point, why "q" variable is not necessary. :)
                If UUID = Cells(j, "A") Then ' You could use your Instansce value instead of UUID there, like this: "Instance(f, 1)"
                    Instance(f, g) = Cells(j, "B") 'If "g" variable will somehow become bigger, than {49}, this could become a reason of your Error.
                    g = g + 1
                End If

            Next j
            f = f + 1
            q = g - 1 ' "q" variable is not used after this row, so it is a strange unnecessary action
        Next i

End Sub

现在，当我们有一些关于错误的信息时，让我对您的代码做一些改进。我确信，为了编写最简单的代码，您可以使用Excel工作表存储和计数数据，并使用VBA作为后台自动化。但是，如果您需要使用数组的代码，让我们执行以下操作！:)

Option Explicit ' It is an option that turns on check for every used variable to be defined before execution. If this option is not defined, your code below will find undefined variables and define them when they are used. Good practice is to use this option, because it helps you, for example to prevent missprinting errors in variable names.

Option Base 1 ' This option sets the default index value for arrays in your code. If this option is not set, the default index value will be {0}.

Const HEADER_ROW = 1 ' It is a number to identify your header row, next row after this one will be counted as a row with data
Const UUID = 1 ' ID of element in our "Instance" array to store UUID
Const DATES_ID = 2 ' ID of element in our "Instance" array to store dates

Function CountUUIDLoop()
    ActiveSheet.Copy After:=ActiveSheet 'Copy your worksheet to new one to ensure that source data will not be affected.
    Dim Instance(), dates() ' "Instance" will be used to store all the data, "dates" will be used to store and operate with dates
    ReDim Instance(2, 1) ' Set first limitation to the "Instance" array in style [[uuid, dates],id]
    ReDim dates(1) ' Set first limitation to the "dates" array
    Instance(DATES_ID, 1) = dates
    Dim CountUUID
    Dim i as Long, j as Long, f as Long, active_element_id As Long 'Integer is quite enough to perform our array manipulations, but Long datatype is recomended (please refer to UPDATE2 below)
    i = HEADER_ROW + 1 ' Set first row to fetch data from the table
    active_element_id = 1 ' Set first active element number
    With ActiveSheet ' Ensure that we are working on active worksheet.
        While .Cells(i, 1) <> "" 'If operated cell is not empty - continue search for data
            If i > HEADER_ROW + 1 Then
                active_element_id = active_element_id + 1 ' increment active element number
                ReDim Preserve Instance(2, active_element_id) ' Assign new limitation (+ 1) for our Instances, don't forget to preserve our results.
                ReDim dates(1) ' Set first limitation to the "dates" array
                Instance(DATES_ID, active_element_id) = dates
            End If
            Instance(UUID, active_element_id) = .Cells(i, 1) ' save UUID
            dates(1) = .Cells(i, 2) ' save first date
            j = i + 1 ' Set row to search next date from as next row from current one.
            While .Cells(j, 1) <> "" 'If operated cell is not empty - continue search for data
                If .Cells(j, 1) = .Cells(i, 1) Then
                    ReDim Preserve dates(UBound(dates) + 1) ' Expand "dates" array, if new date is found.
                    dates(UBound(dates)) = .Cells(j, 2) ' Save new date value.
                    .Cells(j, 1).EntireRow.Delete 'Remove row with found date to exclude double checking in future
                Else
                    j = j + 1 ' If uuid is not found, try next row
                End If
            Wend
            Instance(DATES_ID, active_element_id) = dates
            i = i + 1 'After all the dates are found, go to the next uuid
        Wend
        .Cells(i, 1) = "UUID COUNT" ' This will write you a "UUID COUNT" text in A column below all the rest of UUIDs on active worksheet
        .Cells(i, 2) = i - HEADER_ROW - 1 ' This will write you a count of UUIDs in B column below all the rest of UUIDs on active worksheet
    End With
    CountUUIDLoop = Instance ' This ensures that your function (!) returns an array with all UUIDs and dates inside.
End Function

此函数将在活动工作表底部打印UUID计数，并返回如下所示的数组：[[LOGIN1][1], [[DATE1][DATE2][DATE3]][1]]

我利用这种存储数据的顺序，避免了多维阵列扩展带来的误差。此错误与您的错误相似，因此您可以在此处阅读更多有关此问题的信息：

如何在Excel2007VBA中"ReDim保存“2D数组，以便向数组中添加行而不是列？

Excel VBA -如何实现2D数组的Redim？

在Visual 6中将ReDim保存为多维数组

无论如何，您可以使用my function ("Instance" array)执行进一步的操作，以查找所需的内容，甚至显示uuid-dates值。:)

祝您的进一步VBA行动好运！

更新

下面是演示如何处理上述函数的结果的测试过程：

Sub test()
 Dim UUIDs ' The result of the "CountUUIDLoop" function will be stored there
 Dim i as Long, j As Long ' Simple numeric variables used as indexies to run through our resulting array
 UUIDs = CountUUIDLoop ' assign function result to a new variable
 Application.DisplayAlerts = False ' Disable alerts from Excel
 ActiveSheet.Delete ' Delete TMP worksheet
 Application.DisplayAlerts = True ' Enable alerts from Excel
 If UUIDs(UUID, 1) <> Empty Then ' This ensures that UUIDs array is not empty
    Sheets.Add After:=ActiveSheet ' Add new worksheet after active one to put data into it
    With ActiveSheet 'Ensure that we are working with active worksheet
        .Cells(HEADER_ROW, 1) = "UUIDs/dates" ' Put the header into the "HEADER_ROW" row
        For i = 1 To UBound(UUIDs, 2) ' run through all the UUIDs
           .Cells(1 + HEADER_ROW, i) = UUIDs(UUID, i) ' Put UUID under the header
           For j = 1 To UBound(UUIDs(DATES_ID, i)) ' run through all the dates per UUID
             .Cells(j + 1 + HEADER_ROW, i) = UUIDs(DATES_ID, i)(j) ' put date into column below the UUID
           Next j ' Go to next date
        Next i ' Go to next UUID
        .Cells.EntireColumn.AutoFit ' This will make all columns' width to fit its contents
    End With
 Else
    MsgBox "No UUIDs are found!", vbCritical, "No UUIDs on worksheet" ' Show message box if there are no UUIDs in function result
 End If
End Sub

因此，如果在活动工作表上有以下数据：

..............A.................B

1........LOGIN1.......DATE1

2........LOGIN1.......DATE2

3........LOGIN1.......DATE3

4........LOGIN2.......DATE4

5........LOGIN2.......DATE5

6........LOGIN3.......DATE6

...this子将在新的工作表上放置UUID，如下所示：

..............A.................B.................C

1.UUID/日期

2........LOGIN1........LOGIN2........LOGIN3

3........DATE1.........DATE4.........DATE6

4........DATE2.........DATE5

5........DATE3

UPDATE2

当需要整数(或整数)变量时，建议使用Long数据类型而不是Integer数据类型。Long稍微快一些，它有更广泛的限制，并且不需要额外的内存。这是证据链接：

MSDN:整数、Long和Byte数据类型

Answer 2

我建议使用集合和字典而不是数组。下面的代码将以一种与您想要的方式非常相似的方式构造数据。

Sub collect_logins_by_user_()
    'you need to enable the microsoft scripting runtime
    'in tools - references
    'assuming unique ids are in col A and there are no gaps
    'and assuming dates in col B and there are no gaps
    '
    'The expected runtime for this is O(n) and I have used similar code on more than 250.000 record.
    'It still takes a while obviously, but should run just fine.
    '
    'The the data will bestructed in the following format:
    '{id_1: [d_1, d_2,...], id_2: [d_3, d_4,...], ...}

    Dim current_id As Range: Set current_id = ActiveSheet.Range("A2") 'modify range as required
    Dim logins_by_users As New Dictionary
    While Not IsEmpty(current_id)

        If Not logins_by_users.Exists(current_id.Value) Then
            Set logins_by_users(current_id.Value) = New Collection
        End If
        logins_by_users(current_id.Value).Add current_id.Offset(ColumnOffset:=1).Value
        Set current_id = current_id.Offset(RowOffset:=1)
    Wend

    'Once you have the data structured, you can do whatever you want with it.
    'like printing it to the immediate window.

    Dim id_ As Variant
    For Each id_ In logins_by_users
        Debug.Print "======================================================="
        Debug.Print id_
        Dim d As Variant
        For Each d In logins_by_users(id_)
            Debug.Print d
        Next d
    Next id_
    Debug.Print "======================================================="
End Sub

Answer 3

我已经编写了一些代码，这些代码按照您所要做的做了一些事情--它在调试窗口中打印每个用户的不同数目的连续日志，用逗号分隔。

这段代码使用了字典对象--它本质上是一个关联数组，其中索引不受数组中的数字限制，并且提供了一些方便的特性来操作数组中没有的数据。

我已经在一个工作表上测试了这一点，其中包括colomn中的用户in和B列中的日志日期--包括标题--这看起来很好。自由地试一试

Sub mysub()
    Dim dic As Object
    Dim logs As Variant
    Dim myval As Long
    Dim mykey As Variant
    Dim nb As Long
    Dim i As Long

    Set dic = CreateObject("Scripting.dictionary")

    'CHANGE TO YOUR SHEET REFERENCE HERE
    For Each cell In Range(Cells(2, 1), Cells(Worksheets("Sheet8").Rows.count, 1).End(xlUp))

        mykey = cell.Value
        myval = cell.Offset(0, 1)

        If myval <> 0 Then
            On Error GoTo ERREUR
            dic.Add mykey, myval
            On Error GoTo 0
        End If

    Next cell

    For Each Key In dic

        logs = Split(dic(Key), ",")

        logs = sortArray(logs)

        i = LBound(logs) + 1
        nb = 1

        Do While i <= UBound(logs)

            Do While CLng(logs(i)) = CLng(logs(i - 1)) + 1
                nb = nb + 1
                i = i + 1
            Loop

            If nb > 1 Then
                tot = tot & "," & CStr(nb)
                nb = 1
            End If

            i = i + 1

        Loop

        If tot <> "" Then dic(Key) = Right(tot, Len(tot) - 1)
        Debug.Print "User: " & Key & " - Consecutive logs: " & dic(Key)
        tot = ""
        mys = ""

    Next Key

    Exit Sub

ERREUR:

    If myval <> 0 Then dic(mykey) = dic(mykey) & "," & CStr(myval)
    Resume Next

End Sub


Function sortArray(a As Variant) As Variant
    For i = LBound(a) + 1 To UBound(a)
        j = i
        Do While a(j) < a(j - 1)
            temp = a(j - 1)
            a(j - 1) = a(j)
            a(j) = temp
            j = j - 1
            If j = 0 Then Exit Do
        Loop
    Next i
    sortArray = a
End Function