For each Zelle in Range / Excel 2007 Problem

11/03/2010 - 21:00 von Philipp | Report spam
Hallo Zusammen,

habe folgendes Problem. Ein Reporting Programm làuft bei uns mit Excel 2002
sehr gut. Eines unserer Tochterunternehmen verwendet nun leider Excel 2007.
Dort gibt es mit dem gleichen Code erhebliche Performance Probleme, was in
der Regel zum PC Absturz führt.
Das Programm làuft in Excel 2007 dann im Kompatibilitàtsmodus. Das Problem
hàngt sich in der Regel in einer Schleife "For Each Zelle in Range" auf (das
Programm klapptert ihr so gegen 3000 Zeilen ab).
Diesen Code habe ich mal angehàngt. Das ganze Programm kann ich leider nicht
zur Verfügung stellen. Aber das Problem taucht auch schon auf, wenn ich nur
eine der Subs durchlaufen lasse.
Mir ist auch schon aufgefallen, dass es in anderen Schleifen in denen die
Zeilen durchlaufen genauso langsam ist.
Gibt es bei der Art von Schleife im Excel 2007 üfters Problem oder liegt das
an dem Kompatibilitàtsmodus?

Anbei der Code:

Sub HBI_sperren()
Dim o As Long
Dim u As Long
Dim Zelle As Range
Dim mfs As Worksheet

Set mfs = Sheets("Monthly Financial Statement")
o = mfs.Range("B1").End(xlDown).Row
u = mfs.Range("B65536").End(xlUp).End(xlUp).End(xlUp).Row

Call unprotect(mfs)

For Each Zelle In mfs.Range("J" & o & ":J" & u)
If Zelle.Offset(0, -1).Value = "" Then GoTo sprung
Zelle.Locked = True

sprung:
Next Zelle
Call protect(mfs)
End Sub

Sub HBI_entsperren()
Dim mfs As Worksheet
Set mfs = Sheets("Monthly Financial Statement")

Dim o As Long
Dim u As Long
Dim Zelle As Range
o = 10
'o = mfs.Range("B1").End(xlDown).Row
u = mfs.Range("B65536").End(xlUp).Row
Call unprotect(mfs)
For Each Zelle In mfs.Range("J" & o & ":J" & u)
If Zelle.Offset(0, -1).Value = "" Then GoTo sprung
If Zelle.Interior.ColorIndex = 36 Then Zelle.Locked = True
If Zelle.Interior.ColorIndex = xlNone Then Zelle.Locked = False

sprung:
Next Zelle
Call protect(mfs)
End Sub

Function sap_pruefen(KEinh As Integer) As Boolean
Dim sap As Variant
Dim Bereich As Range
Dim o As Long
Dim u As Long

o = 27
u = Worksheets("FixeWerte").Range("J27").End(xlDown).Row
Set Bereich = Worksheets("FixeWerte").Range("J" & o & ":M" & u)

With Bereich
Set c = .Find(KEinh, LookIn:=xlValues)
If Not c Is Nothing Then
Reihe = c.Row
sap = Worksheets("FixeWerte").Range("M" & c.Row).Value

End If
End With

Select Case sap
Case "x"
sap_pruefen = True
Case Else: sap_pruefen = False
End Select
End Function

Sub sperren()
Dim KEinh As Integer
Dim Version As Integer
Dim sap As Boolean
KEinh = Sheets("Parameters").Range("D9").Value
Version = Sheets("Parameters").Range("D15").Value
If Version = 500 Or Version = 510 Then
sap = sap_pruefen(KEinh)
If sap = True Then Call HBI_sperren
If sap = False Then Call HBI_entsperren
Else
Call HBI_entsperren
End If
End Sub

Function protect(mfs As Worksheet)
mfs.protect ("ErfassungPAG")
End Function
Function unprotect(mfs As Worksheet)
mfs.unprotect ("ErfassungPAG")
End Function
 

Lesen sie die antworten

#1 C. Sekulla
12/03/2010 - 08:36 | Warnen spam
Hallo Philipp,

also ..

bei mir làuft der Code unter 2007 ganz normal (unter 3 sek.) bei über 2000
Zellen.
ABER was das??????

For Each Zelle In mfs.Range("J" & o & ":J" & u)
If Zelle.Offset(0, -1).Value = "" Then GoTo sprung
Zelle.Locked = True

sprung:
Next Zelle

'Goto' ist ein Befehl aus der Reihe: "Böse". Wird seit ca. 15 Jahren nur
aus Kompatibilitàtsgründen mitgeführt.

For Each Zelle In mfs.Range(mfs.Cells(o, 10), mfs.Cells(u, 10))
If Len(CStr(Zelle.Offset(0, -1).Value)) >0 Then
Zelle.Locked = True
endif
Next

Wenn die restlichen Zellen Unlock sein sollten, dann so

For Each Zelle In mfs.Range(mfs.Cells(o, 10), mfs.Cells(u, 10))
Zelle.Locked = Len(CStr(Zelle.Offset(0, -1).Value)) >0
Next

Auch das String-Gematsche ist nicht schön.
"J" & o & ":J" & u ; o und u sind vom Type Long (Zahlen), also
wenn man die Zellenbezüge hat, doch besser über die exakten Indizes gehen.

mfs.Range("J" & o & ":J" & u) besser
mfs.Range(mfs.Cells(o, 10), mfs.Cells(u, 10)) 'Spalte J = 10

Auch sind viele Bezüge nicht definiert und beziehen sich so auf die aktive
Elemente.
Sheets("Parameters")
Hier sollte schon das konkrete Workbock stehen.

Zur Performance:
ich weiß jetzt aus dem Hut nicht, ob .Locked eine Neuberechnung durchführt,
das würde das ganze extrem Verlangsamen, wenn viele Formeln in der Mappe
sind.

Dazu müßte man die automatische Berechnung abschalten und zum Schluß, den
Ausgangsstatus wieder herstellen.

cu CS


"Philipp" schrieb im Newsbeitrag
news:
Hallo Zusammen,

habe folgendes Problem. Ein Reporting Programm làuft bei uns mit Excel
2002 sehr gut. Eines unserer Tochterunternehmen verwendet nun leider Excel
2007. Dort gibt es mit dem gleichen Code erhebliche Performance Probleme,
was in der Regel zum PC Absturz führt.
Das Programm làuft in Excel 2007 dann im Kompatibilitàtsmodus. Das Problem
hàngt sich in der Regel in einer Schleife "For Each Zelle in Range" auf
(das Programm klapptert ihr so gegen 3000 Zeilen ab).
Diesen Code habe ich mal angehàngt. Das ganze Programm kann ich leider
nicht zur Verfügung stellen. Aber das Problem taucht auch schon auf, wenn
ich nur eine der Subs durchlaufen lasse.
Mir ist auch schon aufgefallen, dass es in anderen Schleifen in denen die
Zeilen durchlaufen genauso langsam ist.
Gibt es bei der Art von Schleife im Excel 2007 üfters Problem oder liegt
das an dem Kompatibilitàtsmodus?

Anbei der Code:

Sub HBI_sperren()
Dim o As Long
Dim u As Long
Dim Zelle As Range
Dim mfs As Worksheet

Set mfs = Sheets("Monthly Financial Statement")
o = mfs.Range("B1").End(xlDown).Row
u = mfs.Range("B65536").End(xlUp).End(xlUp).End(xlUp).Row

Call unprotect(mfs)

For Each Zelle In mfs.Range("J" & o & ":J" & u)
If Zelle.Offset(0, -1).Value = "" Then GoTo sprung
Zelle.Locked = True

sprung:
Next Zelle
Call protect(mfs)
End Sub

Sub HBI_entsperren()
Dim mfs As Worksheet
Set mfs = Sheets("Monthly Financial Statement")

Dim o As Long
Dim u As Long
Dim Zelle As Range
o = 10
'o = mfs.Range("B1").End(xlDown).Row
u = mfs.Range("B65536").End(xlUp).Row
Call unprotect(mfs)
For Each Zelle In mfs.Range("J" & o & ":J" & u)
If Zelle.Offset(0, -1).Value = "" Then GoTo sprung
If Zelle.Interior.ColorIndex = 36 Then Zelle.Locked = True
If Zelle.Interior.ColorIndex = xlNone Then Zelle.Locked = False

sprung:
Next Zelle
Call protect(mfs)
End Sub

Function sap_pruefen(KEinh As Integer) As Boolean
Dim sap As Variant
Dim Bereich As Range
Dim o As Long
Dim u As Long

o = 27
u = Worksheets("FixeWerte").Range("J27").End(xlDown).Row
Set Bereich = Worksheets("FixeWerte").Range("J" & o & ":M" & u)

With Bereich
Set c = .Find(KEinh, LookIn:=xlValues)
If Not c Is Nothing Then
Reihe = c.Row
sap = Worksheets("FixeWerte").Range("M" & c.Row).Value

End If
End With

Select Case sap
Case "x"
sap_pruefen = True
Case Else: sap_pruefen = False
End Select
End Function

Sub sperren()
Dim KEinh As Integer
Dim Version As Integer
Dim sap As Boolean
KEinh = Sheets("Parameters").Range("D9").Value
Version = Sheets("Parameters").Range("D15").Value
If Version = 500 Or Version = 510 Then
sap = sap_pruefen(KEinh)
If sap = True Then Call HBI_sperren
If sap = False Then Call HBI_entsperren
Else
Call HBI_entsperren
End If
End Sub

Function protect(mfs As Worksheet)
mfs.protect ("ErfassungPAG")
End Function
Function unprotect(mfs As Worksheet)
mfs.unprotect ("ErfassungPAG")
End Function

Ähnliche fragen