Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

shapes auszählen dauert ewig

Forumthread: shapes auszählen dauert ewig

shapes auszählen dauert ewig
22.07.2004 14:47:45
joe richter
hallo,
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

Anzeige

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: shapes auszählen dauert ewig
22.07.2004 15:14:53
Herbert
Hallo!
Nur so auf die Schnelle einen Vorschlag.
Verwende doch myShape.TopLeftCell.Row als Index für ein numerisches Array.
Dadurch brauchst du nicht AnzahlReihen mal alle Shapes abzuklappern, sondern jedes Shape nur einmal anzugreifen.
Ganz grob könnte das so aussehen ...
For Each myShape In Tabelle23.Shapes
If (myShape.Type = msoShapeRectangle) Then
ShapeCount(myShape.TopLeftCell.Row)=ShapeCount(myShape.TopLeftCell.Row) + 1
End If
....
Next
Nur so ne Idee

Herbert
Anzeige
AW: shapes auszählen dauert ewig
23.07.2004 14:25:39
joe richter
hallo,
leider hat mir dieser lösungsansatz nicht wirklich geholfen, da meine bemühungen mangels fachwissen schon im ansatz kläglich gescheitert sind.
mir will sich einfach diese zeile nicht erschliessen
ShapeCount(myShape.TopLeftCell.Row)=ShapeCount(myShape.TopLeftCell.Row) + 1
als beispiel:
wenn man sich in zeile 3 befindet, lautet der obige code ja so:
ShapeCount(3)=ShapeCount(3) + 1
aber was mache ich nun mit dieser information?
in der hoffnung auf hilfe verbleibe ich mit freundlcihen grüßen
joe
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige