shapes auszählen dauert ewig
22.07.2004 14:47:45
joe richter
ich habe eine tabelle, in der sich eine unbestimmte anzahl rechtecke (msoShapeRectangle) befinden.
diese rechtecke sind zeilenweise angeordnet, d.h. in der ersten waagerechten zeile können sich z.b. 10 rechtecke befinden, in der zweiten 8, in der dritten 9 usw.
mein ziel war es jede zeile einzeln auslesen zu können (was auch für die weitere funktion unbedingt erforderlich ist), und anschließend die gesamtmenge zu berechnen.
dies funktioniert auch mit untenstehendem code, aber seeeeehr langsam (für 10 zeilen ca. 10 sek.).
vielleicht weiss jemand eine möglichkeit dies zu beschleunigen.
danke im voraus
joe
Sub module_zaehlen()
' diese funktion wird von dem button "Module zaehlen" in der tabelle
' Zeichnung aufgerufen, und zählt die anzahl der module, nach dem man
' einzelne module, z.b. um einen kamin herum, gelöscht hat.
Dim myShape As Shape
Dim anzahl As Integer
Dim reihen As Integer
Dim y As Integer
Dim s1 As Integer
Dim z As Integer
Dim zges As Integer
z = 0
reihen = 0
anzahl = 0
zges = 0
For s = 0 To 100 'Auszählung der reihenanzahl
z = Tabelle23.Range("B" & s + 3).Value
If z <> 0 Then
reihen = reihen + 1
End If
Next
For s = 4 To reihen + 3
For Each myShape In Tabelle23.Shapes
If (myShape.Type = msoShapeRectangle) Then
If (myShape.TopLeftCell.Row = s) Then
anzahl = anzahl + 1
End If
End If
Tabelle23.Range("B" & s).Value = anzahl
Next
zges = anzahl + zges
anzahl = 0
Next
Tabelle23.[B2].Value = zges
End Sub