运行下面的代码时收到错误。这个工作在上个月有效，自从我对10月的数据进行了更新以来，似乎就停止了工作。
该脚本应从Derek_Calc中获取数据，该数据是每天到服务器上应用程序的所有登录的列表。然后压缩这些数据以突出显示在给定的一天每小时有多少人登录。
以下行用于设置将数据添加到表中的日期信息以及要在DEREK_Calcs中检查的日期：
Set tempRange = target1.Range("B1706:B1736")
Sub PopulateConcurrency() 'for re-populating specific dates for the 'DEREK_Concurrency_Logins' sheet
'UPDATE THE DATE RANGE below!
Dim thisBook As Workbook
Dim target1 As Worksheet
Dim target2 As Worksheet
Dim dbSheetNames(1 To 2) As String
Dim cell As Variant
Dim cell2 As Variant
Dim searchDate As String
Dim firstColDate As Boolean
Dim userIdLoginCount As Long
Dim startHour As String
Dim endHour As String
Dim startDateTime As Date
Dim endDateTime As Date
Dim startDateHour As Date
Dim endDateHour As Date
Dim hourCounter As Integer
Dim startRange As Range
Dim endRange As Range
Dim tempString As String
Dim counter As Long
Dim userIds() As Long
Dim uniqueIds As Collection, c
Dim targCellRange As Range
Dim tempRange As Range
Dim tempRange2 As Range
dbSheetNames(1) = "DEREK_Concurrency_Logins"
dbSheetNames(2) = "DEREK_Calcs"
Set thisBook = ThisWorkbook
Set target1 = thisBook.Sheets(dbSheetNames(1))
Set target2 = thisBook.Sheets(dbSheetNames(2))
'prepare variables
userIdLoginCount = 0
hourCounter = 0
'de-activate re-calculations for this sheet as these will be updated later
target1.EnableCalculation = False
target2.EnableCalculation = False
'stop screen refreshing
Application.ScreenUpdating = False
Set tempRange = target1.Range("B1706:B1736") 'UPDATE THE DATE RANGE FROM COLUMN B Of THE 'DEREK_Concurrency_Logins' sheet
For Each cell In tempRange 'loop through each date in the DEREK_Concurrency_User_Logins sheet
searchDate = cell.Value
searchDate = Format(searchDate, "dd/mm/yyyy")
firstColDate = True
hourCounter = 0
For hourCounter = 0 To 16 'loop to next hour time range
'get start hour and end hour
startHour = target1.Cells(2, (3 + hourCounter))
startHour = Format(startHour, "hh:mm")
endHour = target1.Cells(2, (4 + hourCounter))
endHour = Format(endHour, "hh:mm")
'prepare variables
Erase userIds
Set uniqueIds = Nothing
Set uniqueIds = New Collection
userIdLoginCount = 0
counter = 0
With target2
Set tempRange2 = target2.Range("DEREK_LoginDaily")
For Each cell2 In tempRange2 'loop through each cell2 In DEREK_LoginDaily
If (StrComp(searchDate, cell2.Value) = 0) Then 'check for date match
If firstColDate = False Then
Set startRange = cell2
Set endRange = cell2
'get start and end hours for the hour period
startDateTime = startRange.Offset(0, 7).Value
endDateTime = endRange.Offset(0, 8).Value
'get the login start and finish times
tempString = Day(startDateTime) & "/" & Month(startDateTime) & "/" & Year(startDateTime) & " " & Format(startHour, "hh:mm")
startDateHour = CDate(tempString)
tempString = Day(endDateTime) & "/" & Month(endDateTime) & "/" & Year(endDateTime) & " " & Format(endHour, "hh:mm")
endDateHour = CDate(tempString)
If startDateTime <= startDateHour And endDateTime >= endDateHour Then
Sheets(dbSheetNames(2)).Select
startRange.Offset(0, 10).Select
startRange.Offset(0, 10).Activate
ReDim Preserve userIds(counter)
If (startRange.Offset(0, 10).Length > 0) Then
If startRange.Offset(0, 6).Value = 1 Then
userIds(counter) = startRange.Offset(0, 10).Value
End If
End If
counter = counter + 1 'increment counter
End If 'end hour concurency check
Else 'if firstColDate is True
startHour = target1.Cells(2, 2) 'code for 7am - 8am, set startHour to 07:00
endHour = target1.Cells(2, 4) 'set endHour to 08:00
Set startRange = cell2
Set endRange = cell2
'get start and end hours for the hour period
startDateTime = startRange.Offset(0, 7).Value
endDateTime = endRange.Offset(0, 8).Value
'get the login start and finish times
tempString = Day(startDateTime) & "/" & Month(startDateTime) & "/" & Year(startDateTime) & " " & Format(startHour, "hh:mm")
startDateHour = CDate(tempString)
tempString = Day(endDateTime) & "/" & Month(endDateTime) & "/" & Year(endDateTime) & " " & Format(endHour, "hh:mm")
endDateHour = CDate(tempString)
If startDateTime <= startDateHour And endDateTime >= endDateHour Then
Sheets(dbSheetNames(2)).Select
'THIS IS WHERE THE ERROR IS :-(
startRange.Offset(0, 10).Select
startRange.Offset(0, 10).Activate
ReDim Preserve userIds(counter)
If (startRange.Offset(0, 10).Length > 0) Then
If startRange.Offset(0, 6).Value = 1 Then
userIds(counter) = startRange.Offset(0, 10).Value
End If
End If
counter = counter + 1 'increment counter
End If 'end hour concurency check
End If 'end if firstColDate
End If 'end if a date match
Next cell2 'loop through each cell2 In DEREK_LoginDaily
End With
'get unique values by putting array into a collection
On Error Resume Next
For Each c In userIds
If Not IsEmpty(c) Then
uniqueIds.Add Item:=c, Key:=CStr(c)
End If
Next c
'populate target cell
Set targCellRange = cell
targCellRange.Offset(0, (2 + hourCounter)) = (uniqueIds.count)
firstColDate = False
Next hourCounter 'loop to next hour time range
firstColDate = True
Next cell 'loop through each date in the DEREK_Concurrency_User_Logins sheet
MsgBox "Complete"
End Sub
答案 0 :(得分：0)
不确定如何，但是此行是问题所在：
startRange.Offset（0，10）.Length> 0
对于范围选项，不能有长度。我得到了一些帮助，并将行更改为此：
Len（startRange.Offset（0，10）.Value）
现在可以正确填充了。整个脚本工作是获取一个包含登录日期和时间的数据工作表，然后填充另一个表，详细说明每小时按小时计算的系统中的用户数量。
谢谢大家的帮助！