將日期轉換並分隔為年/月/周數

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 行時，您才可以使用integers （變量存儲為 16 位（2 字節））而不是long整數（變量存儲為 32 位（4 字節））。

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