将日期转换并分隔为年/月/周数

Question

我有一个日期范围。我想将这些日期的年、月和周数分隔到不同的列中。
我有以下代码，逐个单元格地计算它们：

Sub Sortdata()
    Dim WBData As Workbook
    Dim Lastrow As Long
    Dim j as long
    Dim D as Date
    
    Set WBData = ThisWorkbook
    Lastrow = WBData.Sheets("CDR").Cells(Rows.Count, "A").End(xlUp).row
    
    For j = 2 To Lastrow
        D = WBData.Sheets("CDR").Cells(j, 5) 'date 
        
        WBData.Sheets("CDR").Cells(j, 19) = Year(D)
        WBData.Sheets("CDR").Cells(j, 20) = Month(D)
        WBData.Sheets("CDR").Cells(j, 21) = Application.WorksheetFunction.WeekNum(D)
    Next j
End Sub

有时最后一行超过 1000 行，需要太多时间。

我怎样才能改进这段代码，让它在更短的时间内运行？

Answer 1

我有一个想法，虽然我不完全确定它是否有效。

将 Lastrow 分成 8 部分（或更少）。运行 8 个单独的循环，并让它们全部由一个子调用，以便它们同时运行。 您编码一次，然后将代码复制粘贴到 8 个不同的模块中。 Vba 是单线程的，但一些用户说如果 subs 位于不同的模块中，则 subs 可以同时运行。 所以基本上一个会运行 1 到 125，另一个运行 126 到 250 等等。

没试过，不知道行不行。

Answer 2

一些使它更快的建议：

1.- 仅当您的表是少于 32,000 行。

2.- 关闭不必要的应用程序。

3.- 避免使用您并不真正需要的函数，例如 Rows.Count

4.- 使用with 语句。

试试这个：

Sub Sortdata()

'turn off unnecessary applications
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
   
Dim WBData As Workbook
Dim Lastrow As Integer
Dim j As Integer
Dim D As Date

Set WBData = ThisWorkbook
Lastrow = WBData.Sheets("CDR").Cells(1048576, 5).End(xlUp).Row

 For j = 2 To Lastrow
     
     D = WBData.Sheets("CDR").Cells(j, 5) 'date
     
     With WBData.Sheets("CDR")
         .Cells(j, 19) = Year(D)
         .Cells(j, 20) = Month(D)
         .Cells(j, 21) = WorksheetFunction.WeekNum(D)
     End With
     
 Next j

'remember to turn applications back on..
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
    
End Sub

Answer 3

如果你有兴趣，这里有一个完全不循环的版本（应该是最快的）：

Sub Macro1()
Dim Lastrow As Long
Dim WBData As Workbook

Set WBData = ThisWorkbook

With WBData.Sheets("CDR")
    Lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
    Range(.Cells(2, 19), .Cells(Lastrow, 19)).Formula = "=Year(E2)"
    Range(.Cells(2, 20), .Cells(Lastrow, 20)).Formula = "=Month(E2)"
    Range(.Cells(2, 21), .Cells(Lastrow, 21)).Formula = "=WeekNum(E2)"
    Range(.Cells(2, 19), .Cells(Lastrow, 21)).Value = Range(.Cells(2, 19), .Cells(Lastrow, 21)).Value
End With

End Sub