美文网首页
vba字符串转日期案例

vba字符串转日期案例

作者: 猛犸象和剑齿虎 | 来源:发表于2024-01-19 14:27 被阅读0次
    41651ba8bbe77cffecb6ef54d560d77.png

    vba在使用字典将日期和其他字段拼接后作为主键,再获取之后,涉及将拼接主键重新拆分成日期和其他字段,那么这时拆分后的日期会变成字符串形式。


    image.png

    实际上日期字段作为一个重要信息,后续还有其他操作的话就涉及将字符串字段重新转换成日期格式。


    image.png
    由于日期读取时含有星期几,不符合字符串转日期格式的条件,所以先采用文本函数取出字符串日期格式,然后再转成日期格式后,读到新的数组或者写入到单元格中。
    image.png
    Sub saleamount()
        Dim arr
        Dim uniqueArr() As Variant
        Dim i As Long, j As Long, n As Long
        Dim d As Object
    Worksheets("发货明细汇总").Range("A5:ag63356").Borders.LineStyle = xlNone
    Worksheets("发货明细汇总").Range("A5:c63356").Clear
    icount = Worksheets("年成品日出入明细表").[a63356].End(xlUp).Row
    arr = Worksheets("年成品日出入明细表").Range("a2:o" & icount)
        ' 初始化数组和字典
        Set d = CreateObject("Scripting.Dictionary")
        ' 使用字典找出不重复的订单号、产品和日期
        For i = 1 To UBound(arr)
            If arr(i, 2) <> "合计:" And arr(i, 2) <> "总计:" _
            And arr(i, 14) <> 0 _
            Then
                d(arr(i, 1) & "|" & arr(i, 3)) = d(arr(i, 1) & "|" & arr(i, 3)) + arr(i, 14) '组合成键值
            End If
        Next i
        
        ReDim uniqueArr(1 To d.Count, 1 To 3)
        j = 1 '新数组的索引
        For Each Key In d.keys
            arrkey = Split(Key, "|") '分割键值得到订单号、产品和日期
            uniqueArr(j, 1) = CDate(Left(arrkey(0), InStr(arrkey(0), " ") - 1)) '日期
            uniqueArr(j, 2) = arrkey(1) '客户名称
            uniqueArr(j, 3) = d(Key) '发货
            j = j + 1
        Next Key
            For n = 1 To UBound(uniqueArr)
            Worksheets("发货明细汇总").Cells(n + 4, "A").Value = uniqueArr(n, 1)
            Worksheets("发货明细汇总").Cells(n + 4, "b") = uniqueArr(n, 2)
            Worksheets("发货明细汇总").Cells(n + 4, "c") = uniqueArr(n, 3)
        Next
        
    '表格区域绘制框线
    ncount = [a63356].End(xlUp).Row
    Worksheets("发货明细汇总").Range("A5:ag" & ncount).Borders.LineStyle = xlContinuous
    
     For k = 1 To UBound(uniqueArr)
            '检查日期是否在指定时间段内
            If Cells(k + 4, 1) >= [c1] And Cells(k + 4, 1) <= [f1] Then
                '如果日期在指定时间段内,则保留该行数据,否则将其隐藏
                Rows(k + 4).Hidden = False
            Else
                Rows(k + 4).Hidden = True
            End If
        Next k
    'Range("A5:AG" & ncount).Sort Key1:=Range("B4"), Order1:=xlAscending
    End Sub
    

    相关文章

      网友评论

          本文标题:vba字符串转日期案例

          本文链接:https://www.haomeiwen.com/subject/gwqjodtx.html