EdgeTop bei Signalwort

[joshua]

Hallo Community!

Aufbauend zu meinem vorherigen Thread suche ich nun wieder Rat bei euch.
Und zwar möchte ich das beim Wort "Exit" (Like), ein EdgeTop von A:S gezogen wird. Mit dem Folgenden Code erhalte ich innerhalb der Zeile einen EdgeTop.

Wo genau liegt der Fehler?

Code:

Sub EdgeExit()

  Dim Zeile As Long
  Dim ZeileMax As Long
  Dim Text As Variant
 
  With tblTest
   
       Text = "*exit*"
      ZeileMax = .UsedRange.Rows.Count
     
          For Zeile = 2 To ZeileMax
               If Not InStr(1, .Range("I" & Zeile).Value, Text, 1) = 1 Then
              .Range("A" & Zeile).Borders(xlEdgeTop).LineStyle = xlContinuous
              .Range("B" & Zeile).Borders(xlEdgeTop).LineStyle = xlContinuous
              .Range("C" & Zeile).Borders(xlEdgeTop).LineStyle = xlContinuous
              .Range("D" & Zeile).Borders(xlEdgeTop).LineStyle = xlContinuous
              .Range("E" & Zeile).Borders(xlEdgeTop).LineStyle = xlContinuous
              .Range("F" & Zeile).Borders(xlEdgeTop).LineStyle = xlContinuous
              .Range("G" & Zeile).Borders(xlEdgeTop).LineStyle = xlContinuous
              .Range("H" & Zeile).Borders(xlEdgeTop).LineStyle = xlContinuous
              .Range("I" & Zeile).Borders(xlEdgeTop).LineStyle = xlContinuous
              .Range("J" & Zeile).Borders(xlEdgeTop).LineStyle = xlContinuous
              .Range("K" & Zeile).Borders(xlEdgeTop).LineStyle = xlContinuous
              .Range("L" & Zeile).Borders(xlEdgeTop).LineStyle = xlContinuous
              .Range("M" & Zeile).Borders(xlEdgeTop).LineStyle = xlContinuous
              .Range("N" & Zeile).Borders(xlEdgeTop).LineStyle = xlContinuous
              .Range("O" & Zeile).Borders(xlEdgeTop).LineStyle = xlContinuous
              .Range("P" & Zeile).Borders(xlEdgeTop).LineStyle = xlContinuous
              .Range("Q" & Zeile).Borders(xlEdgeTop).LineStyle = xlContinuous
              .Range("R" & Zeile).Borders(xlEdgeTop).LineStyle = xlContinuous
              .Range("S" & Zeile).Borders(xlEdgeTop).LineStyle = xlContinuous
              End If
               
           Next Zeile
         
  End With
 
End Sub

[RPP63]

Moin!
Mal eins vorweg.
Statt Deines Rattenschwanzes geht auch schlicht:
.Range(.Cells(Zeile, "A"), .Cells(Zeile, "S")).Borders(xlEdgeTop).LineStyle = xlContinuous

Gruß Ralf

[RPP63]

Zum Zweiten:
Lade mal eine Beispielmappe hoch.
Bei sowas sollte der Turbo eingeschaltet werden können.
Sprich: Lösung über Autofilter und .SpecialCells(xlCellTypeVisible)

Gruß Ralf

[RPP63]

Zum Dritten:
Warum nicht einfach per bedingter Formatierung?

[joshua]

Vielen Dank für die Antwort!

I. Entschuldige für den Rattenschwanz.
II. Verstehe jetzt nicht so genau was ich mit ".SpecialCells(xlCellTypeVisible)" anfangen soll. Habe gerade in meinem Buch nachgeschaut aber nichts dazu gefunden :/
III. Es ist gut möglich, dass das fertige Projekt am Ende als Add-In verteilt wird. Bisher wurde VBA gefordert.

Der Code sind nur folgendermaßen aus

Code:

Sub EdgeNone()
   Dim Zeile As Long
  Dim ZeileMax As Long
  Dim Text As Variant   
   With tblSummary   
       Text = "*none*"
      ZeileMax = .UsedRange.Rows.Count       
           For Zeile = 2 To ZeileMax
               If Not InStr(1, .Range("I" & Zeile).Value, Text, 1) = 1 Then
               .Range(.Cells(Zeile, "A"), .Cells(Zeile, "S")).Borders(xlEdgeTop).LineStyle = xlContinuous
              End If
          Next Zeile           
   End With  
End Sub

[RPP63]

Was hat denn ein Add-In damit zu tun, dass keine bed. Form. gehen soll?
Wandele die Tabelle in ein Listobject (Einfügen, Tabelle).
Markiere den Datenbereich,
bed. Form., Neue Regel,
Formel zur Ermittlung …: =FINDEN("none";$I2)
Format Rahmen oben
Fertig

Da "intelligente" Tabelle, brauchst Du auch nichts mehr anpassen, wenn sich die Tabelle erweitert oder Zeilen gelöscht werden.
Datei im Anhang.

Gruß Ralf

[joshua]

Hallo Ralf,

das ist auch eine super Möglichkeit! Vielen Dank :19:

Trotzdem würde ich gerne wissen, was an meinem Code falsch ist?
Und auch gerne würde ich auf deinen ".SpecialCells(xlCellTypeVisible)" zurückkommen.

[RPP63]

Auch wenn ich die bed. Form als sinnvoll erachte, mal der Code mit den Dich neugierig machenden SpecialCells ;)
Ich habe die hochgeladene Datei genommen und zunächst die bed. Form. gelöscht.

Sub RPP()
With Tabelle1.Range("Tabelle2")
   .AutoFilter 9, "*none*"
   .SpecialCells(xlCellTypeVisible).Borders(xlEdgeTop).LineStyle = xlContinuous
   .AutoFilter
End With
End Sub

Da ist aber natürlich kein Automatismus drin, könnte man aber über ein _Change triggern.

Gruß Ralf

[joshua]

Ralf, vielen Dank für deine Vorschlag.

Leider funktioniert er nicht zu 100%.
Viele Zeilen werden übersprungen oder nicht beachtet.

Gibt es eine Lösung zu meinem Ansatz, auch wenn dieser nicht der effektivste und effizienteste ist?
Ebenfalls würde ich gerne aus meinen Fehlern lernen und entsprechend gerne erfahren, wo der Fehler an meinem Ansatz liegt.

[RPP63]

Viele Zeilen werden übersprungen oder nicht beachtet.

Ich bat ja bereits um eine Beispielmappe.
In meiner Datei funktionierte das ja einwandfrei.

Gibt es eine Lösung zu meinem Ansatz, auch wenn dieser nicht der effektivste und effizienteste ist?

Das schaue ich mir dann auch mit Deinen Daten an.
Zur Effektivität:
Eine Schleife über Zellen ist immer die denkbar schlechteste (weil langsamste) Variante.
Aber fürs Verständnis schaue ich dann noch mal genauer.
Bin aber jetzt für ~ zwei Stunden offline.

Gruß ralf