Question

我是VBA的新手，我有一个项目，需要从一个大的.csv文件中对数据进行排序，该文件包含一个月的全年停车场信息。

csv文件仅包含三个参数。

-UNIX时间戳记，它指示汽车进入/离开停车场的时间。

-用户ID ，用于识别进入/离开公园的人。

-输入/输出标签，用于通知该人是否在给定的时间戳记下进入/离开了公园。

将文件存储在数组中并打印后，看起来像这样。

我的目标是按照发生的月份对这些条目进行排序，为每个月创建一个新的Excel工作表，但最重要的是，在每个新工作表中，格式必须为：

-唯一事件ID -标识此特定事件的随机唯一ID。（必须与另一个工作表中的每个事件ID都不同）

-用户ID -与上述相同

-IN的时间戳-用户进入公园的时间戳

-OUT的时间戳-用户离开公园的时间戳。

对所有内容进行排序后，每个月度工作表应如下所示：

这是我的代码部分，它从文件中读取每一行（我需要帮助）

Dim dict As New Scripting.Dictionary
numLines = 0

Do Until EOF(1)
    Line Input #1, Line
    elements = Split(Line, ";")

    'Store in an array
    someArray(numLines, 0) = elements(0)
    someArray(numLines, 1) = elements(1)
    someArray(numLines, 2) = elements(2)

    'ts - elements(0)
    'uID - elements(1)
    'evID - elements(2)

    'I'm trying store the data in a dictionary with the IN timestamp as
    'the key and the userID as the item but I still can't figure out
    'how to look for the next timestamp of the user and store it so I could
    'print it in another sheet

    'dict.Add elements(0), elements(1)
    'Debug.Print elements(0), dict(elements(0))

    numLines = numLines + 1
Loop
Close #1

Range("A1:C" & totalFileLines).value = someArray

我遇到过字典，发现这可能是我的一个很好的解决方案，但是我没有成功，所以可以随意提出任何看起来更简单的解决方法，因为正如我所说，对于VBA来说，它还是一个相当新的事物，我在项目的这一部分工作非常困难，因此我们将不胜感激。谢谢。

Answer 1

在关于阅读文件的评论中回答您的问题，如下所示：

请注意，我正在使用早期绑定（设置对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，并且每个OUT都有一个IN，则可以按顺序进行。但是最好还是检查一下，并随时间存储事件类型，以免出错。或将ts成对存储（数组），第一个元素为IN，第二个元素为OUT。先按USER ID然后按TS先对数据进行排序，这可能会有所帮助，因为您只需要检查下面的行以确认用户ID和OUT事件（在每个IN事件之后）是否相等。

Edit2

我认为以下将满足您的要求。尽管不是必需的，但我使用的是类模块，因为它使文档和修改变得更加简单。

这是算法：

将整个CSV文件读入变量数组
- 分割换行符
写入临时工作表
- 先按用户ID排序，然后再按时间
- 如果两者都存在，这应该导致顺序的输入/输出
- 可以编写一个VBA排序例程，但是我碰巧没有一个快速的，“稳定的”例程，并且Excel排序非常灵活，稳定且快速。
按照排序顺序，创建一个词典，其中Key是生成的序列号，而item是由用户ID，TS IN和TS OUT组成的类对象
- 必须检查下一行，以确保存在与该用户的IN匹配的OUT，否则，请勿将其添加到字典中。
创建结果工作表-所有数据一个，每个月一个。
将结果写入结果工作表。在monthIN中添加一列（有关该计算，请参见“类”模块）
过滤结果以填充“月份”工作表

Class Module

'**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

中找到有关课程基本信息的出色参考。

如何将csv文件中的数据存储和排序到字典VBA

1 个答案:

编辑

Edit2

Class Module

常规模块