在工作表上输入日期数组将转换为美国格式

Question

我在VBA中有一系列日期。如果我一次将一个日期打印到纸张上，一切都很完美。但是，当我将整个数组批量打印到列时，日期格式会从（dd / mm / yy）更改为（mm / dd / yy）。因此5月7日转换为7月5日和5月25日未在表格上格式化为日期。

这是我的代码。

（另一个较小的问题：如何在打印到列时摆脱转置的需要？这段“伪代码”执行30K次。）

Public Sub test05()
Dim dt As Date, fromDate As Date, toDate As Date
Dim dayCounter As Integer
Dim sheet As Worksheet
Dim dtArr() As Date
Set sheet = Sheets("Sheet1")
fromDate = DateSerial(2018, 8, 6)
toDate = DateSerial(2023, 8, 5)
sheet.Cells.ClearContents
dayCounter = 0
For dt = fromDate To toDate
    wd = Weekday(dt)
    If wd = 1 Or wd = 7 Then
        'skip weekends
        GoTo NextDayIteration
    End If
    dayCounter = dayCounter + 1

    ReDim Preserve dtArr(1 To dayCounter)

    dtArr(dayCounter) = dt

    'print the dates (one by one) to the sheet in column 1
    sheet.Cells(dayCounter, 1).Value2 = dt
NextDayIteration:
Next 'end of each day

'print all the dates array to the sheet in bulk, in column 2
Dim rng As Range
With sheet
    Set rng = .Range(.Cells(1, 2), .Cells(UBound(dtArr) - LBound(dtArr) + 1, 2))
End With

rng.Value2 = Application.Transpose(dtArr)

End Sub

Answer 1

不要使用Transpose或Preserve。你可以这样做：

Public Sub test05()
Dim dt As Date, fromDate As Date, toDate As Date
Dim dayCounter As Long
Dim sheet As Worksheet
Dim dtArr() As Date
Set sheet = Sheets("Sheet1")
fromDate = DateSerial(2018, 8, 6)
toDate = DateSerial(2023, 8, 5)
ReDim dtArr(1 To toDate - fromDate + 1, 1 To 1)
sheet.Cells.ClearContents
dayCounter = 0
For dt = fromDate To toDate
    wd = Weekday(dt)
    Select Case wd
    Case 1, 7
        'skip weekends
    Case Else
    dayCounter = dayCounter + 1

    dtArr(dayCounter, 1) = dt

    'print the dates (one by one) to the sheet in column 1
    sheet.Cells(dayCounter, 1).Value2 = dt
    End Select
Next 'end of each day

'print all the dates array to the sheet in bulk, in column 2
Dim rng As Range
With sheet
    Set rng = .Range(.Cells(1, 2), .Cells(dayCounter, 2))
End With

rng.Value2 = dtArr

End Sub