Leere Zelle erzeugt Fehler 2007 bzw 13
21.10.2006 15:53:12
Reinhard
ich habe da eine Riesendatei (5MB), schön farbig und mit Formeln und bed. Formatierung gespickt. Sie hat 3 Blätter.
Nun wollte ich mal all das rauswerfen um zu sehen wie klein sie wird wenn ich die Formeln usw. auf Vba umstelle. Die erwähnten Dinge zu löschen und dann das jeweilige Blatt in eine leere Datei zu kopieren scheiterte bei 2 der 3 Blätter, Excel verschwand grußlos vom Bildschirm. Ich mutmaße mein Arbeitsspeicher ist zu klein o.ä. weil es ja immer mit dem einen Blatt problemlos klappte (es hat nur 150000 benutze Zellen, die anderen 6 Mio. Deshalb das nachstehende Makro.
Ohne Fehlerbehandlung erscheint Fehler 2007 wenn ich mich auf "Zelle" stelle im Debugger.
Mit Fehlerbehandlung so ist der Typ "Fehler", Adresse wird angezeigt (ist ca. die 2 millionste Zelle im Usedrange).
Bei Value kommt dann wie ohne Fehlerbehandlung Fehler13, Typen unverträglich in
"If Zelle.Value "" Then"
In der Tabelle ist die Zelle für mich leer, bei Länge(U10321) kommt 0 und auch bei "=U10321 * 1" kommt 0.
Wenn ich einen Bereich um diese Zelle U10321 in eine andere Datei kopiere, tritt der Fehler nicht auf, also liegt es irgendwie doch nicht am Zelleninhalt*denk*
Die Datei ist hier zu finden:
http://www.badongo.com/file/1579494
Option Explicit
Sub tt()
Dim Zelle, Blatt, b, n
Blatt = Array("Depot", "T", "C")
Workbooks.Add
On Error GoTo Fehler
Application.ScreenUpdating = False
For b = 0 To UBound(Blatt)
MsgBox ThisWorkbook.Worksheets(Blatt(b)).UsedRange.Cells.Count
n = 0
For Each Zelle In ThisWorkbook.Worksheets(Blatt(b)).UsedRange
'For Each Zelle In ThisWorkbook.Worksheets(Blatt(b)).UsedRange.Cells
n = n + 1
'If n Mod 10000 = 0 Then MsgBox n
With Zelle
If Zelle.Value <> "" Then
'MsgBox Zelle.Value
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
.Copy Destination:=ActiveWorkbook.Worksheets(b + 1).Range(Zelle.Address)
End If
End With
Next Zelle
Next b
Application.ScreenUpdating = True
Exit Sub
Fehler:
Application.ScreenUpdating = True
MsgBox TypeName(Zelle.Value)
MsgBox Zelle.Address
MsgBox Zelle.Value
End Sub
Danke ^ Gruß
Reinhard
Anzeige