Question

我在StackOverflow上发布了同样的问题thread 但我认为这是正确的地方（如果不对，请管理员将其删除）。每天我需要格式化从AS400导入的日期（数据，时间，..）。 Usualy（数千条记录）我使用此代码。

Public Sub Cfn_FormatDate(control As IRibbonControl)
Application.ScreenUpdating = False
    Dim UR As Long, X As Long
    Dim MyCol As Integer
    MyCol = ActiveCell.Column
    UR = Cells(Rows.Count, MyCol).End(xlUp).Row
    For X = 2 To UR
        If Not IsDate(Cells(X, MyCol)) Then
            Select Case Len(Cells(X, MyCol))
            Case 8
                Cells(X, MyCol) = DateSerial(Left(Cells(X, MyCol), 4), Mid(Cells(X, MyCol), 5, 2), Right(Cells(X, MyCol), 2))
            Case 6
                Cells(X, MyCol) = DateSerial(Left(Cells(X, MyCol), 2), Mid(Cells(X, MyCol), 3, 2), Right(Cells(X, MyCol), 2))
            End Select
        End If
    Next X
Columns(MyCol).NumberFormat = "DD/MM/YYYY;@"
Columns(MyCol).EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub

但如果记录更多，则代码发布的代码不会执行。（前70K记录在18秒内格式化/粘贴）所以我想在数组中使用变量，我写了这段代码：

Sub ConvDate(c As Integer)
Application.ScreenUpdating = False
Dim lrw As Long, i As Long
Dim ArrVal As Variant
lrw = ActiveSheet().Range(Cells(1, c)).End(xlDown).Row
ReDim ArrVal(2 To lrw)
For i = 2 To lrw
    If IsDate(Cells(i, c)) Then
        ArrVal(i) = Cells(i, c)
    Else
        Select Case Len(Cells(i, c)) ' to check YYYYMMDD or YYMMDD
            Case 8
                ArrVal(i) = DateSerial(Left(Cells(i, c), 4), Mid(Cells(i, c), 5, 2), Right(Cells(i, c), 2))
            Case 6
                ArrVal(i) = DateSerial(Left(Cells(i, c), 2), Mid(Cells(i, c), 3, 2), Right(Cells(i, c), 2))
        End Select
    End If
NextX:
    Next i
Range(Cells(2, c), Cells(lrw, c)) = ArrVal
Columns(c).NumberFormat = "DD/MM/YYYY;@"
Columns(c).EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub

不起作用，所有细胞（在范围内）具有相同的结果（细胞（2，c））。一个人建议我改变代码：

ActiveSheet.Range(Cells(2, c), Cells(lrw, c)).Value = WorksheetFunction.Transpose(ArrVal)

此更改有限制，超过65536条记录我收到错误（运行时13，类型不匹配）

Answer 1

您遇到了Transpose函数的32 bit limitation，它将您的数组截断为65536.

Answer 2

好的，总结一下所有的答案和评论：

正如您在问题中指出的那样，并且正如user85489所暗示的那样，将值读取到数组中，操作相同的数组，然后将其写回到工作表中，比逐个单元地删除要快得多。
如果你有一个阵列＆＃39; row＆＃39;维度不会改变。那么可以公平地说，你最好声明一个2维数组大小（1到行，1到列）。这样就可以避免转换一维数组。
因为Gareth指出，Transpose()仅限于维度中的65536个元素。

总而言之，你的帖子的骨架代码可能就是这样：

Sub ConvertDates(colIndex As Long)
    Dim v As Variant
    Dim firstCell As Range
    Dim lastCell As Range
    Dim fullRange As Range
    Dim i As Long
    Dim dd As Integer
    Dim mm As Integer
    Dim yy As Integer
    Dim dat As Date

    'Define the range
    With ThisWorkbook.Worksheets("Sheet1")
        Set firstCell = .Cells(2, colIndex)
        Set lastCell = .Cells(.Rows.Count, colIndex).End(xlUp)
        Set fullRange = .Range(firstCell, lastCell)
    End With

    'Read the values into an array
    v = fullRange.Value

    'Convert the text values to dates
    For i = 1 To UBound(v, 1)
        If Not IsDate(v(i, 1)) Then
            If Len(v(i, 1)) = 6 Then v(i, 1) = "20" & v(i, 1)
            yy = CInt(Left(v(i, 1), 4))
            mm = CInt(Mid(v(i, 1), 5, 2))
            dd = CInt(Right(v(i, 1), 2))
            dat = DateSerial(yy, mm, dd)
            v(i, 1) = dat
        End If
    Next

    'Write the revised array and format range
    With fullRange
        .NumberFormat = "DD/MM/YYYY;@"
        .Value = v
        .EntireColumn.AutoFit
    End With

End Sub

Answer 3

您可以使用循环语句填充单元格，否则如果您想直接执行此操作，请将数组ArrVal定义为：

Redim ArrVal（1，Lrw）作为变体

使用值填充数组，然后像

一样卸载它

范围（单元格（2，c），单元格（lrw，c））= ArrVal

希望你摆脱相同的价值错误。

将带有＆gt; 100K项目的一个数组（单个维度）粘贴到Excel范围

3 个答案: