VBA数组麻烦错误9脚本超出范围
感谢您阅读我的问题，
给我一个约25万条目名单和logindate列表，陪同每个条目显示他们login时。 我的任务是找出连续几天login哪些用户，频率和次数。
即鲍勃·史密斯连续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] [UUID2，B1，B2，B3，B4] [UUID3 ，B1，B2]
如果UUID是用户，则B1代表用户login的date，b2将是他们login的下一个date等。一些用户的date比其他date更多或更less。
我的主要问题是随着我不断收到不同的错误而设置数组。 我不知道如何定义这个二维数组，因为会有超过30 000行，每个都有1-> 85列。
任何帮助表示赞赏，让我知道如果有什么需要进一步澄清。 再一次，这是我第一次使用VBA，所以我提前抱歉，如果我所做的一切都是错误的。
PS我使用ReDim实例（50,50）作为testing，看看我是否可以通过预定义工作，但同样的错误发生。 再次感谢！
据我的理解你的问题和代码，你有一个表结构如下：
………….. A …………….. B
1 …….. LOGIN1 ……. DATE1
2 …….. LOGIN1 ……. DATE2
3 …….. LOGIN1 ……. DATE3
4 …….. Login2身份……. DATE4
5 …….. Login2身份……. DATE5
6 …….. LOGIN3 ……. DATE6
而你在这个代码中的任务是以这样的二维结构获取数据：
RESULT_ARRAY-
………………………. | -LOGIN1-
…………………………………….. | -DATE1
…………………………………….. | -DATE2
…………………………………….. | -DATE3
………………………. | -LOGIN2-
…………………………………….. | -DATE4
…………………………………….. | -DATE5
………………………. | -LOGIN3-
…………………………………….. | -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]]
我已经使用这个存储数据的顺序来避免multidimensional array扩展的错误。 这个错误与您的错误类似，所以您可以在这里阅读更多关于此的信息：
在Excel 2007 VBA中如何“ReDim保留”二维数组，以便我可以添加行而不是列到数组？
Excel VBA – 如何Redim的二维数组？
ReDim保留在Visual Basic 6中的multidimensional array中
无论如何，你可以使用我的函数输出（ "Instance" array ）执行进一步的操作来find你所需要的，甚至显示你的uuiddate值。 🙂
祝你进一步的VBA行动！
UPDATE
以下是显示如何使用上述函数结果的testing过程：
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
…这个子将把UUID放在这个新的表单上：
………….. A …………….. B …………….. C
1点……..的UUID /date
2 …….. LOGIN1 …….. Login2身份…….. LOGIN3
3 …….. DATE1 ……… ……… DATE4 DATE6
4 …….. DATE2 ……… DATE5
5 …….. DATE3
UPDATE2
当需要整数（或整数）variables时，推荐使用Long数据types而不是Integer 。 Long是稍快，它有更广泛的限制和成本没有额外的内存。 这里是certificate链接：
MSDN：整型，长型和字节数据types
我会build议使用集合和字典，而不是数组。 下面的代码将以与您想要的方式非常相似的方式来构造数据。
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
我已经写了一些代码，沿着你正在做的事情做了一些事情 – 它在debugging窗口中输出每个用户不同数量的连续日志，用逗号分隔。
这段代码使用了字典对象 – 它本质上是一个关联数组，其索引不像数组中那样受限于数字，并且提供了一些方便的特性来处理数组中的数据。
我已经在包括colomn A中的用户id和列B中的日志date（包括头文件）在一张表上testing了这一点，并且这看起来工作正常。 请随意试试看
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