Fügen Sie ein Array (einzelne Dimension) mit> 100K Artikel in einen Excel-Bereich

Question

Ich habe die gleiche Frage auf StackOverflow thread geschrieben, aber ich denke, hier ist der richtige Ort zu fragen (wenn nicht richtig ist, bitte entfernen Admin). Jeden Tag muss ich das von AS400 importierte Datum formatieren (Daten, Zeit, ..). Normalerweise (für einige tausend Datensätze) benutze ich diesen Code.

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 

Wenn die Datensätze jedoch viel mehr sind, wird der Code Code nicht ausgeführt. (ex 70K Aufzeichnungen wurden in 18 Sekunden formatiert/Einfügen) so dachte ich Variablen in einem Array zu verwenden, und ich schrieb diesen Code:

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 

es nicht funktionieren, alle Zellen (im Bereich) haben die gleiches Ergebnis (Zellen (2, c)). ein Mann und schlug mir den Code zu ändern, wie:

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

diese Änderung ist die Begrenzung, über 65.536 Datensätze erhalte ich einen Fehler (Laufzeit 13, Typ Mismatch)

Answer 1

Ok, die Antworten und Kommentare alle zusammenfassen:

1. Wie Sie in Ihrer Frage und als user85489 anspielt angedeutet haben, die Werte in ein Array zu lesen, dass gleiche Array Manipulation, und es zurück an das Schreiben Blatt ist viel schneller als Zelle für Zelle.
2. Wenn Sie ein Array haben, dessen 'Zeilen'-Dimension sich nicht ändert. Dann könnte es fair sein zu sagen, dass es besser ist, ein zweidimensionales Array von Größe zu deklarieren (1 zu Zeilen, 1 zu Spalten). Auf diese Weise können Sie vermeiden, ein 1-dimensionales Array zu transponieren.
3. Da Gareth darauf hinweist, ist Transpose() auf 65536 Elemente in einer Dimension beschränkt.

setzen sie alle zusammen, dann könnte Skeleton-Code für Ihren Beitrag sein:

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

Sie über die 32 bit limitation der Funktion gekommen sind transponieren, die Ihr Array kürzt bis 65536

Answer 3

Sie Loop-Anweisung verwenden können, die Zellen zu füllen, sonst, wenn Sie es direkt tun wollen dann Array definieren arrval mag:

Redim arrval (1, Lrw) als

Variante

Flood das Array mit den Werten und dann Offload es wie

Range (Cells (2, c), Zellen (lrw, c)) = arrval

Hoffentlich Sie den gleichen Wert loswerden Fehler.