如何转换或解析字符串以使用dateserial VBA Excel

时间:2016-10-30 20:59:19

标签: arrays excel vba excel-vba

我有一列数据,由两个元素组成(以字符串形式输入)。

3/20/2016 6:30:55 PM
3/12/2016 8:15:45 PM
3/8/2016 1:25:18 AM

我想将变量设置为等于上述字符串日期部分的DateSerial。

我不想将数据分开并让它们驻留在不同的列中。我希望保持格式不变。

我将加载一个包含表中所有数据的数组(多列),但我希望数组按日期编制索引。我将在数组上运行quicksort,然后使用已排序的数组进行一些额外的交叉引用。但是,我无法通过实际数据集进入这些阶段,因为我被困在日期问题上。

如何根据源数据的格式按日期编制索引?

Dim d as Date
Dim arTemp
Dim arTemp1
Dim WS As Worksheet
Dim list As Object, list1 As Object
Dim RowCount as Integer, y As Integer

Set list = CreateObject("System.Collections.SortedList")
Set list1 = CreateObject("System.Collections.SortedList")

For Each WS In WorkSheets
    With WS
        For RowCount = 7 to 207
            'Works perfectly if the data in Column 1 is actually a date
            d = DateSerial(Year(.Cells(RowCount, 1)), Month(.Cells(RowCount, 1)), 1)

                If list.Containskey(d) Then
                    arTemp = list(d) 
                    arTemp1 = list1(d)'omitted from code below but follows the same format
                Else
                    ReDim arTemp(8)
                    ReDim arTemp1(8)
                End If
                For y = 2 to 7 'Cycle through the columns and load array/list
                    arTemp(0) = arTemp(0) + .Cells(RowCount, y) 'Grab Km
                    arTemp(1) = arTemp(1) + .Cells(RowCount, y) 'Grab Route Hrs
                    arTemp(2) = arTemp(2) + .Cells(RowCount, y) 'Grab No. Deliveries
                    arTemp(3) = arTemp(3) + .Cells(RowCount, y) 'Grab No. of Del Pieces
                    arTemp(4) = arTemp(4) + .Cells(RowCount, y) 'Grab No. Pick-ups
                    arTemp(5) = arTemp(5) + .Cells(RowCount, y) 'Grab No. of PU Pieces
                    arTemp(6) = arTemp(6) + .Cells(RowCount, y) 'Grab Total Stops
                    arTemp(7) = arTemp(7) + .Cells(RowCount, y) 'Grab Total Pieces
                    arTemp(8) = arTemp(8) + 1
                    list(d) = arTemp
            'do other stuff here .........................................
            Next y
        Next RowCount
    End With
Next

2 个答案:

答案 0 :(得分:4)

您是否尝试使用DateValue()而不是DateSerial()?

使用DateValue,您只需使用代码

即可
DateVariable = DateValue("10/30/2016 09:18 pm")

它将解决

DateVariable = 10/30/2016

应该比尝试使用DateSerial

简单得多

然后,您可以添加以下行

DateVariable = DateVariable - Day(DateVariable) + 1

要到达本月的第一天

答案 1 :(得分:1)

替换:

d = DateSerial(Year(.Cells(RowCount, 1)), Month(.Cells(RowCount, 1)), 1)

使用:

Dim s As String
s = .Cells(RowCount, 1)
ary = Split(s, " ")
bry = Split(ary(0), "/")
mm = CLng(bry(0))
yy = CLng(bry(2))
d = DateSerial(yy, mm, 1)