每半小时如何获取最接近的日期

似乎您的第一个问题是将数据导入Excel。了解Excel可能不是处理大量数据的最佳程序（Access等DB程序可能更好），因此您需要将数据拆分到多个列或工作表中；或取样数据。

您选择了采样，因此在您读取数据时，我将进行采样和测试。

在处理包括毫秒在内的日期/时间戳时，您还必须处理Excel / VBA限制。

但是出于测试数据的目的，无需担心毫秒。只要您的数据是按升序排列的，则第一行的日期/时间戳等于或大于您的30分钟的增量将是最早的一行。

下面的代码应仅读取符合该条件的巨大文件中的行。请阅读注释以获取更多信息。

将这些行收集到一个集合中；然后声明一个结果数组，将其填充，并将结果写入工作表。

如果每行包含多个字段，而不仅仅是显示的单个行，那么在编写结果时，您将声明结果数组以容纳所有列，并在那时将其填充。

使用Collection / Array /写入工作表序列比处理每一行时将每一行一次写入工作表要快得多。

有一些方法可以加快代码的速度，也有解决可能的“内存不足”错误的方法，但这取决于您的实际数据以及此简单代码的处理方式。

到目前为止，我们需要将Excel解释为字符串的日期/时间戳转换为“实际”日期/时间，这取决于您要对后续数据进行的处理。

==========================================

Option Explicit
'Set Reference to Microsoft Scripting Runtime
Sub GetBigData()
    Dim FSO As FileSystemObject
    Dim TS As TextStream
    Dim vFileName As Variant
    Dim sLine As String
    Dim dtLineTime As Date
    Dim dtNextTime As Date
    Dim colLines As Collection

vFileName = Application.GetOpenFilename("Text Files(*.txt), *.txt")
If vFileName = False Then Exit Sub

Set FSO = New FileSystemObject
Set TS = FSO.OpenTextFile(vFileName, ForReading, False, TristateFalse)
Set colLines = New Collection

With TS
    'Assumes date/time stamps are contiguous
    'skip any header lines
    Do
        sLine = .ReadLine
    Loop Until InStr(sLine, ".") > 0

'Compute first "NextTime"
'  note that it might be the first entry
'  comment line 3 below if want first entry
'  but would need to add logic if using other time increments
dtLineTime = CDate(Left(sLine, InStr(sLine, ".") - 1))
dtNextTime = Int(dtLineTime) + TimeSerial(Hour(dtLineTime), Int(Minute(dtLineTime) / 30) * 30, 0)
If Not (Minute(dtLineTime) = 30 Or Minute(dtLineTime) = 60) Then dtNextTime = dtNextTime + TimeSerial(0, 30, 0)

Do
    'Due to IEEE rounding problems, need to test equality as a very small value
    'Could use a value less than 1 second = 1/86400 or smaller
    If Abs(dtLineTime - dtNextTime) < 0.00000001 Or _
        dtLineTime > dtNextTime Then
            colLines.Add sLine
            dtNextTime = dtNextTime + TimeSerial(0, 30, 0)
    End If
    If Not .AtEndOfStream Then
        sLine = .ReadLine
        dtLineTime = CDate(Left(sLine, InStr(sLine, ".") - 1))
    End If
Loop Until .AtEndOfStream

.Close
End With

'Write the collection to the worksheet
Dim V As Variant
Dim wsResults As Worksheet, rResults As Range
Dim I As Long

Set wsResults = Worksheets("sheet1")
Set rResults = wsResults.Cells(1, 1)

ReDim V(1 To colLines.Count, 1 To 1)
Set rResults = rResults.Resize(UBound(V, 1), UBound(V, 2))

For I = 1 To UBound(V, 1)
     V(I, 1) = CStr(colLines(I))
Next I

With rResults
    .EntireColumn.Clear
    .NumberFormat = "@"
    .Value = V
    .EntireColumn.AutoFit
End With

End Sub

==========================================

EDIT添加了时间戳转换功能。这可以在将数据从集合对象复制到变量数组的时候实现。例如：

V(I, 1) = ConvertTimeStamp(colLines(I))

由于接收到的值是Double数据类型，因此您还需要适当地设置工作表上的该列的格式，而不是将其设置为Text：

.NumberFormat = "yyyy-mm-dd hh:mm:ss.000"

由于VBA日期类型的数据不支持毫秒，因此我们必须以Double形式返回该值。

=============================

Private Function ConvertTimeStamp(sTmStmp As String) As Double
    Dim dtPart As Date
    Dim dMS As Double 'milliseconds
    Dim V As Variant

'Convert the date and time
V = Split(sTmStmp, ".")
dtPart = CDate(V(0))
dMS = V(1)

ConvertTimeStamp = dtPart + dMS / 86400 / 1000

End Function

=============================