将一个包含 >100K 项目的数组(单维)粘贴到 excel 范围内

Question

我在StackOverflow线程上发布了同样的问题但我认为这里是正确的地方问(如果是不对的，管理员请删除它)。每天我都需要格式化从AS400导入的日期(数据，时间，…)。通常(对于数千条记录)我使用这个代码。

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

，但如果记录是很多，代码张贴代码不执行。(例如，在18秒内格式化/粘贴70K记录)所以我想在数组中使用变量，我写了下面的代码:

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

它不工作，所有单元格(在范围内)有相同的结果(cells (2, c))。有人建议我修改如下代码:

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

这个变化是有限的，超过65536条记录我得到一个错误(运行时13，类型不匹配)

Answer 1

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

1. 正如您在问题中所指出的，正如user85489所暗示的那样，将值读取到数组中，操作相同的数组，并将其写回工作表，比逐个单元格跳线要快得多。
2. 如果你有一个数组的"行"维度不会改变。那么公平地说，您最好声明一个大小为2维的数组(1到行，1到列)。这样你就可以避免对一维数组进行转置。
3. 因为正如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 2

您遇到了函数转置的32位限制，它将您的数组截断为65536。

Answer 3

您可以使用循环语句填充单元格，否则，如果您想直接这样做，则定义您的数组ArrVal:

reredm ArrVal(1,Lrw)作为变量

用值填充数组，然后像

那样卸载它

Range(Cells(2, c)， Cells(lrw, c)) = ArrVal

希望你能消除相同值的错误