В ответ на ваш вопрос в комментарии о прочтении файла, что-то вроде ниже:
Обратите внимание, что я использую раннее связывание (установите ссылку на 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
будет хранить метки времени, связанные с каждым идентификатором пользователя.
Если вы предполагаете, что у каждого пользователя есть IN, и что для каждого IN есть OUT, то вы можете просто пройти последовательно. Но вам лучше бы проверить, а также сохранить тип события во времени, чтобы избежать ошибок. Или хранить ts в парах (массивах) с первым элементом, являющимся IN, и вторым, являющимся OUT. Предварительная сортировка данных по ИД ПОЛЬЗОВАТЕЛЯ, а затем по ТС может быть полезной, поскольку вам нужно будет только проверить строку ниже на равенство идентификатора пользователя и событие OUT (после каждого события IN).
Edit2
Я думаю, что следующее будет делать то, что вы хотите.
Хотя это и не обязательно, я использую модуль класса, поскольку он значительно упрощает документирование и модификации.
Вот алгоритм:
- Считать весь CSV-файл в массив вариантов
- Разделить на символ новой строки
- Написать на временный рабочий лист
- сортировка по идентификатору пользователя, затем по времени
- Это должно привести к последовательному вводу / выводу, если оба существуют
- Может написать подпрограмму сортировки VBA, но у меня нет быстрой, "стабильной", а сортировка в Excel довольно гибкая, а также стабильная и быстрая.
- С отсортированным порядком создайте словарь, в котором Ключ - это сгенерированный последовательный номер, а элемент - это объект класса, состоящий из ID пользователя, TS IN и TS OUT.
- необходимо проверить следующую строку, чтобы убедиться, что есть OUT, который соответствует IN для этого пользователя, в противном случае не добавляйте его в словарь.
- Создание таблиц результатов - по одному для всех данных и по одному на каждый месяц.
- Запишите результаты в таблицу результатов. Включить столбец для месяцаIN (см. Модуль 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:
До тех пор, пока это возможно, отличную справочную информацию по базовой информации о классах можно найти на странице позднего сайта Чипа Пирсона Введение в занятия