日期时间周分列代码

tengyt

日期时间周分列代码

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   With Worksheets("sheet1")
   
5.     r = .Cells(.Rows.Count, 4).End(xlUp).Row
   
6.     arr = .Range("d2:d" & r)
   
7.     ReDim brr(1 To UBound(arr), 1 To 12)
   
8.     For i = 1 To UBound(arr)
   
9.       rq = CDate(arr(i, 1))
   
10.       brr(i, 1) = DateValue(arr(i, 1))
    
11.       brr(i, 2) = TimeValue(arr(i, 1))
    
12.       brr(i, 4) = "周" & Application.Choose(Weekday(brr(i, 1)), "一", "二", "三", "四", "五", "六", "日")
    
13.       brr(i, 12) = IIf(brr(i, 2) <= #12:00:00 PM#, "上午", "下午")
    
14.     Next
    
15.     .Columns(12).NumberFormatLocal = "hh:mm:ss"
    
16.     .Range("k2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
17.   End With
    
18. End Sub
    

复制代码

chxw68

详见附件。

tengyt

chxw68 发表于 2019-12-10 21:18

太完美了，谢谢老师，谢谢谢谢

iwangyi

Sub C()
N = Range("D65536").End(xlUp).Row
For i = 2 To N
a = Split(Cells(i, "D"), " ")
Cells(i, "x") = a(0): Cells(i, "y") = a(1)
Cells(i, "z") = Weekday(Cells(i, "x"))
Next
End Sub

iwangyi

附件请参考************

YZC51

学习老师的代码。谢谢老师！
Sub test2()
    Dim r%, i%
    Dim arr, brr
    With Worksheets("sheet1")
        r = .Cells(.Rows.Count, 4).End(xlUp).Row
        arr = .Range("d2:d" & r)
        ReDim brr(1 To UBound(arr), 1 To 12)
        For i = 1 To UBound(arr)
            rq = CDate(arr(i, 1))
            brr(i, 1) = DateValue(arr(i, 1))
            brr(i, 2) = TimeValue(arr(i, 1))
            brr(i, 4) = "周" & Right(Format(brr(i, 1), "aaa"), 1)
            brr(i, 12) = Mid("上下", -Int(-brr(i, 2) * 2), 1) & "午"
        Next
        .Columns(12).NumberFormatLocal = "hh:mm:ss"
        .Range("k2").Resize(UBound(brr), UBound(brr, 2)) = brr
    End With
End Sub