Hallo,
das und die hohe Formelanzahl könnten die Ursache sein, da ist die Ursachenforschung etwas zeitaufwändiger, Du könntest aber versuchen noch an mehreren Stellen die Auswertung über VBA zu steuern.
Wenn Du die Daten vom der Prozedur 'test' sowieso in einem Makro benötigst, kannst Du meine Proc am besten mit dem Makro verknüpfen und benötigst dann die Eingabe in das Tabellenblatt nicht mehr...
Hier als Bonus noch eine etwas flüssigere Version, die ohne Spaltentausch auskommt und die Daten ab Zeile 1 einträgt ( zu steuern über Const START_INSERTROW As Long = 1) ...
Option Explicit
Public Sub test()
Const START_INSERTROW As Long = 1
Const START_ROW As Long = 6
Const READCOLUMN_DATE As Long = 36
Const PRINTCOLUMN_DATE As Long = 38
Const READCOLUMN_VALUE As Long = 35
Const PRINTCOLUMN_VALUE As Long = 37
Dim avntArray As Variant
Dim avntValues() As Variant
Dim lngColumn As Long, lngCount As Long
Dim ialngRow As Long, ialngColumn As Long
Dim objCell As Range
Dim aobjRange(1 To 2) As Range
Application.ScreenUpdating = False
With ActiveSheet
If .Cells(.Rows.Count, PRINTCOLUMN_DATE).End(xlUp).Row >= .Cells(.Rows.Count, PRINTCOLUMN_VALUE).End(xlUp).Row Then
lngColumn = PRINTCOLUMN_DATE
Else
lngColumn = PRINTCOLUMN_VALUE
End If
.Cells(START_ROW, PRINTCOLUMN_VALUE).Resize(.Cells(.Rows.Count, lngColumn).End(xlUp).Row, 2).ClearContents
If .Cells(.Rows.Count, READCOLUMN_DATE).End(xlUp).Row >= .Cells(.Rows.Count, READCOLUMN_VALUE).End(xlUp).Row Then
lngColumn = READCOLUMN_DATE
Else
lngColumn = READCOLUMN_VALUE
End If
avntArray = .Cells(START_ROW, READCOLUMN_VALUE).Resize(.Cells(.Rows.Count, lngColumn).End(xlUp).Row, 2)
lngColumn = UBound(avntArray, 2)
For ialngColumn = 1 To UBound(avntArray, 2)
lngCount = 0
For ialngRow = 1 To UBound(avntArray, 1)
If ialngColumn = 1 Then
If avntArray(ialngRow, ialngColumn) <> vbNullString Then
lngCount = lngCount + 1
ReDim Preserve avntValues(1, lngCount - 1) As Variant
End If
End If
If avntArray(ialngRow, lngColumn) <> vbNullString Then
If ialngColumn = 2 Then _
lngCount = lngCount + 1
avntValues(ialngColumn - 1, lngCount - 1) = avntArray(ialngRow, lngColumn)
End If
Next
lngColumn = lngColumn - 1
Next
.Cells(START_INSERTROW, PRINTCOLUMN_VALUE).Resize(UBound(avntValues, 2) + 1, 2) = WorksheetFunction.Transpose(avntValues)
Set aobjRange(1) = .Cells(START_INSERTROW, PRINTCOLUMN_VALUE).Resize(UBound(avntValues, 2) + 1, 1)
Set aobjRange(2) = .Cells(START_INSERTROW, PRINTCOLUMN_DATE).Resize(UBound(avntValues, 2) + 1, 1)
aobjRange(1).NumberFormat = "m/d/yyyy"
aobjRange(2).NumberFormat = "General"
For Each objCell In aobjRange(1)
If objCell = vbNullString Then _
Set objCell = Nothing: Exit For
objCell = DateValue(objCell)
Next
End With
Erase aobjRange
Application.ScreenUpdating = True
End Sub
Gruß,
|