---

Hallo,

durch mehrere Tipps aus diesem Forum habe ich mir folgendes Programm "zusammengestrickt"

Sub Bordererkennung()
'Ändert alle Linienfarben auf grau

'Farbe
'Grau 50 = ColorIndex = 16
'Positionen = xlEdgeTop xlEdgeBottom xlEdgeRight
'            xlEdgeLeft xlDiagonalDown xlDiagonalUp

    Dim Bereich As Range
    Dim Zelle As Object
    Set Bereich = Selection

    For Each Zelle In Bereich
        Zelle.Select
        Linienfarbe xlEdgeTop
        Linienfarbe xlEdgeBottom
        Linienfarbe xlEdgeRight
        Linienfarbe xlEdgeLeft
        Linienfarbe xlDiagonalDown
        Linienfarbe xlDiagonalUp
    Next
   
End Sub

Sub Linienfarbe(Position)
    If (Selection.Borders(Position).LineStyle <> xlNone) _
        Then Selection.Borders(Position).ColorIndex = 16
End Sub

Nun habe ich das Problem, das es bei mehremaligen Aufruf immer langsamer wird 

Was kann man hier machen?

Schon mal vielen Dank für eure Hilfe

VG
Wolfgang

------------------
LISP = Lots of Insane Stupid Parantheses

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

hmm, ich hatte ein 87 x 88 grosses Array - das benötigte 47 Sec
mit vorgeschaltetem Application.ScreenUpdating = False nur noch 12Sec
und ohne Schleife dafür mit Linienfarbe xlInsideVertical & Linienfarbe xlInsideHorizontal < 1 sec

Die Zeiten waren aber immer konstant

HTH

Code:

---

Sub Bordererkennung()
'Ändert alle Linienfarben auf grau

'Farbe
'Grau 50 = ColorIndex = 16
'Positionen = xlEdgeTop xlEdgeBottom xlEdgeRight
'            xlEdgeLeft xlDiagonalDown xlDiagonalUp

    Dim Bereich As Range
    Dim Zelle As Object
    Set Bereich = Selection
t = Time
Application.ScreenUpdating = False
   ' For Each Zelle In Bereich
    '    Zelle.Select
        Linienfarbe xlEdgeTop
        Linienfarbe xlEdgeBottom
        Linienfarbe xlEdgeRight
        Linienfarbe xlEdgeLeft
        Linienfarbe xlDiagonalDown
        Linienfarbe xlDiagonalUp
        Linienfarbe xlInsideVertical
        Linienfarbe xlInsideHorizontal
       
  '  Next
Cells(1, 1) = Time - t
Application.ScreenUpdating = True
End Sub

Sub Linienfarbe(Position)
    If (Selection.Borders(Position).LineStyle <> xlNone) _
        Then Selection.Borders(Position).ColorIndex = 16
End Sub

---

------------------
Am Anfang war kein Licht - und Vater blickte Kalt
Miss Brauch

[Diese Nachricht wurde von Thomas Harmening am 14. Mrz. 2006 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Thomas,

vielen Dank für dein Test. Leider muß ich das Gegenteil feststellen.

Beim ersten Durchlauf geht es auch sehr schnell. Aber dann wird es immer langsamer, bis das Prog stehen bleibt. Wenn ich Excel schließe und dann die Tabelle öffne, habe ich wieder die volle Geschwindigkeit.

Gibt es eine Möglichkeit, dass nicht immer die Zelle markiert werden muß, um die Linienfarbe zu ändern (so etwas wie ActiveCell.Offset ...)
Habe leider in VBA nicht die Kenntnisse, um so etwas zu erstellen.

Vielleicht kannst du mir ja bitte helfen?

VG
Wolfgang

------------------
LISP = Lots of Insane Stupid Parantheses

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Wolfgang, Thomas,

@Wolfgang: naja, du fährst aber auch mit angezogener Handbremse, -=select=- ... ;;-))))

@Thomas: ja hmmm sag' ich auch mal;-)

Sicher kann man die ganze Selection auf einmal umfärben, das hat aber eben den Nachteil, dass Zellen die keinerlei 'Borderstyle' hatten, einen mit verpasst bekommen, zumindest bei mir.

Hab' auch nix bessres gefunden, als durch die Selection zu iterieren und jede Zelle einzeln abzufragen, das macht die Geschichte natürlich reichlich unperformant.
Sind 2 Subs, erstere geht nur bedingt, kommt auf die Borders() an [hab ich nich so geblickt auf die Schnelle], geht dafür bissel flotter als die 2.te, aber das Gelbe vom Ei isses ihmo auch nicht.

Gruss Nancy
--

Code:

---

Sub one_for_each()
    Dim a#
    Dim cell As Range
    a = Timer
    Application.ScreenUpdating = 0
    For Each cell In Selection
        If cell.Borders.LineStyle <> xlNone Then cell.Borders.ColorIndex = 5
    Next
    Application.ScreenUpdating = 1
    Cells(1, 1) = Timer - a
End Sub

Sub two_for_each()
    Dim a#
    Dim cell As Range, bord As Border
    a = Timer
    Application.ScreenUpdating = 0
    For Each cell In Selection
        For Each bord In cell.Borders
            If bord.LineStyle <> xlNone Then bord.ColorIndex = 5
        Next
    Next
    Application.ScreenUpdating = 1
    Cells(1, 1) = Timer - a
End Sub

---

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo nochmal,

Wolfgang, gerade erst gelesen ...

> Gibt es eine Möglichkeit, dass nicht immer die Zelle markiert werden muß

Ja genau das meinte ich mit Handbremse;-)

Das Select brauchste nicht um nicht zu sagen fast nie.

Der Code hier macht zb dasselbe wie der andre, nur dasser viel schneller geht:

Code:

---

sub slow()
  dim i&
    for i=1 to 30000
      cells(i,1).select
      activecell.value=1
    next
end sub

sub fast()
  dim i&
    for i=1 to 30000
      cells(i,1).value=1
    next
end sub

---

Du kannst also die Cells auch direkt ansprechen, ohne dass sie selektiert sein müssen;-)

HTH, Nancy

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

border1.jpg border2.jpg

Okayokay..., mal zur Richtigstellung des ganzen;-)

ist noch nicht ganz schlüssig, die Fragestellung ..., also gehts:

A) nur um Bereiche, die sowieso von vornherein eine zusammenhängende Borderstruktur hatten und haben sollen, also sowas:

oder gehts um Fall B)?

looks fast gleich, sind aber zwei verschiedene Paar Schuhe, äh - Schnürsenkel, ehm um nicht zu sagen, Barfuss oder Lackschuh, Sekt oder Selters, Schleife oder Klettband;;-)) (Danke Thomas)

lg Nancy

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,

vielen Dank für die Antworten.

@Startrek : Ich kann nur sagen: Ja, auch!!
Es können immer Fall A) und B) vorkommen!!!

VG
Wolfgang

------------------
LISP = Lots of Insane Stupid Parantheses

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP