在关于阅读文件的评论中回答您的问题,如下所示:
请注意,我使用的是早期绑定(设置对 Microsoft Scripting Runtime 的引用),但您也可以使用后期绑定,尤其是在分发代码的情况下。
Dim V
Dim fn As Variant
Dim FSO As FileSystemObject, TS As TextStream
fn = Application.GetOpenFilename("CSV Files(*.csv),*.csv")
If fn = False Then Exit Sub
Set FSO = New FileSystemObject
Set TS = FSO.OpenTextFile(fn, ForReading, False, TristateUseDefault)
V = Split(TS.ReadAll, vbNewLine)
V 现在将包含一个从零开始的数组,其中每个元素由csv 文件中的一行/行组成。
编辑
针对您关于在 Dictionary 对象中存储信息的问题,如果您将代码更改为:
If Not dict.Exists(elements(1)) Then
Set collec = New Collection
collec.Add elements(0)
dict.Add (elements(1)), collec
Else
dict(elements(1)).Add elements(0)
End If
将存储与每个用户 ID 关联的时间戳。
如果您假设每个用户都有一个IN,并且每个IN 都有一个OUT,那么您可以按顺序进行。但你最好检查一下,并将事件类型与时间一起存储,以免出错。或将 ts 成对(数组)存储,第一个元素为 IN,第二个元素为 OUT。按 USER ID 和 TS 对数据进行预排序可能会有所帮助,因为您只需要检查下面一行的用户 ID 是否相等,以及一个 OUT 事件(在每个 IN 事件之后)。
编辑2
我认为以下内容会满足您的要求。
虽然没有必要,但我使用了一个类模块,因为它使文档和修改变得更加简单。
算法如下:
- 将整个 CSV 文件读入一个变量数组
- 写入临时工作表
- 按用户 ID 排序,然后按时间排序
- 如果两者都存在,这应该会导致顺序 IN/OUT
- 可以编写 VBA 排序例程,但我没有一个快速、“稳定”的例程,而且 Excel 排序非常灵活,而且稳定且快速。
- 按照排序顺序,创建字典,其中Key为生成的序号,item为由User ID、TS IN和TS OUT组成的类对象
- 必须检查下一行以确保存在与该用户的 IN 匹配的 OUT,否则,请勿将其添加到字典中。
- 创建结果工作表 - 一个用于所有数据,一个用于每个月。
- 将结果写入结果工作表。为 monthIN 添加一列(请参阅该计算的 Class 模块)
- 过滤结果以填充月份工作表
类模块
'**RENAME**: cUser
Option Explicit
Private puserID As String
Private ptmIN As Long
Private ptmOUT As Long
Public Property Get userID() As String
userID = puserID
End Property
Public Property Let userID(value As String)
puserID = value
End Property
Public Property Get tmIN()
If ptmIN = 0 Then
tmIN = ""
Else
tmIN = ptmIN
End If
End Property
Public Property Let tmIN(value)
ptmIN = value
End Property
Public Property Get tmOUT()
If ptmOUT = 0 Then
tmOUT = ""
Else
tmOUT = ptmOUT
End If
End Property
Public Property Let tmOUT(value)
ptmOUT = value
End Property
Public Property Get monthIN() As Long
monthIN = Month(DateAdd("s", Me.tmIN, DateSerial(1970, 1, 1)))
End Property
Public Property Get monthOUT() As Long
monthOUT = Month(DateAdd("s", Me.tmOUT, DateSerial(1970, 1, 1)))
End Property
常规模块
Option Explicit
Sub inOUT()
Dim FSO As FileSystemObject, TS As TextStream
Dim dU As Dictionary, cU As cUser
Dim fn As Variant
Dim vSrc, vRes, V
Dim I As Long, J As Long
Dim sKey As String
Dim wb As Workbook, ws As Worksheet, r As Range
Dim wsRes As Worksheet, wsMonth(1 To 12) As Worksheet, rMonth As Range
Dim eventID As Long
'Read file
fn = Application.GetOpenFilename("Text File (*.txt;*.csv), *.txt;*.csv")
If fn = False Then Exit Sub
Set FSO = New FileSystemObject
Set TS = FSO.OpenTextFile(fn, ForReading, False, TristateUseDefault)
vSrc = Split(TS.ReadAll, vbNewLine) ' line = one array element
'write to temp worksheet
'split text to columns
'sort by user id, then by time
'read back into array
'delete the temp worksheet
Application.ScreenUpdating = False
Set wb = ThisWorkbook
Set ws = Worksheets.Add
Set r = ws.Cells(1, 1).Resize(UBound(vSrc) + 1)
r = WorksheetFunction.Transpose(vSrc)
r.TextToColumns DataType:=xlDelimited, textqualifier:=xlTextQualifierDoubleQuote, consecutivedelimiter:=True, _
Tab:=False, semicolon:=False, comma:=True, Space:=False, other:=False
Set r = r.CurrentRegion
r.Sort key1:=r.Columns(2), order1:=xlAscending, key2:=r.Columns(1), order2:=xlAscending, Header:=xlYes, MatchCase:=False
vSrc = r
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
'collect into dictionary
'assign sequential event ID's
'new event ID for every `IN` event
'same event ID if Next line is an `OUT` and `user id` matches
eventID = 0
Set dU = New Dictionary
For I = 2 To UBound(vSrc, 1) 'skip header line
If IsNumeric(vSrc(I, 1)) Then
eventID = eventID + 1
Set cU = New cUser
With cU
.userID = vSrc(I, 2)
If vSrc(I, 3) = "IN" Then .tmIN = vSrc(I, 1)
If vSrc(I + 1, 3) = "OUT" And vSrc(I + 1, 2) = .userID Then
.tmOUT = vSrc(I + 1, 1)
I = I + 1
'add to dictionary
dU.Add Key:=eventID, Item:=cU
End If
End With
End If
Next I
'create results array
ReDim vRes(0 To dU.Count, 1 To 5)
'headers
vRes(0, 1) = "Event ID"
vRes(0, 2) = "User ID"
vRes(0, 3) = "TS IN"
vRes(0, 4) = "TS OUT"
vRes(0, 5) = "Month IN"
'Data
I = 0
For Each V In dU.Keys
I = I + 1
Set cU = dU(V)
With cU
If (.tmOUT - .tmIN) < (86400 * 48) And _
.monthIN = .monthOUT Then
vRes(I, 1) = V
vRes(I, 2) = .userID
vRes(I, 3) = .tmIN
vRes(I, 4) = .tmOUT
vRes(I, 5) = .monthIN
End If
End With
Next V
'set results worksheets
Application.ScreenUpdating = False
On Error Resume Next
For J = 1 To 12
Set wsMonth(J) = Worksheets(MonthName(J))
If Err.Number = 9 Then
Set wsMonth(J) = Worksheets.Add
wsMonth(J).Name = MonthName(J)
End If
wsMonth(J).Cells.Clear
Next J
Set wsRes = Worksheets("Results")
If Err.Number = 9 Then
Set wsRes = Worksheets.Add
wsRes.Name = "Results"
End If
On Error GoTo 0
'write and sort all the results
Set r = wsRes.Cells(1, 1).Resize(UBound(vRes, 1) + 1, UBound(vRes, 2))
With r
.EntireColumn.Clear
.value = vRes
.Range(.Columns(3), .Columns(4)).NumberFormat = "#"
.Sort key1:=r.Columns(3), order1:=xlAscending, Header:=xlYes
.Style = "Output"
.EntireColumn.AutoFit
'Filter to the month sheets
For J = 1 To 12
.AutoFilter Field:=5, Criteria1:=J
.Resize(columnsize:=4).SpecialCells(xlCellTypeVisible).Copy wsMonth(J).Cells(1, 1)
wsMonth(J).UsedRange.EntireColumn.AutoFit
Next J
End With
r.AutoFilter
End Sub
以下是January 工作表上的结果:
只要它可用,就可以在已故的 Chip Pearson 的网站页面Introduction to Classes 上找到有关课程基本信息的极好参考