Bereiche löschen abhängig von Zahlenwert

Hallo zusammen,
ich bin leider ein kompletter Neuling auf dem Gebiet mit Excel und VBA, habe zwar hier und da schon etwas Erfahrung gesammelt, aber der Vorhang hebt sich sehr langsam. 😁
Daher hoffe ich hier auf Hilfe. Mit Schleifen hab ich es noch nicht so drauf.
Ich möchte auf einem Tabellenblatt in der Reihe 10, von Spalte C bis H nach dem Wert "0" suchen.
Sollte zb. Eine 0 in Spalte C gefunden werden, sollen Bereiche darunter 11-39, 46-66, 68-85 und 92-112 gelöscht werden und die Rahmenlinien xlThin (xlInsideHorizontal sollte da reichen) nachgezeichnet werden.
Danach dasselbe,sofern der Wert 0 gefunden wird für die übrigen Spalten. Die Bereiche sind die gleichen,nur eben die entsprechende Spalte.
Ich bekomme die Schleife leider nicht hin und auch die Verbindung von ClearContents mit Selection.Interior und Pattern, TintAndShade etc. mit SelectionBorders, LineStyle, Weight klappt nicht.
Vielleicht kann mich jmd hier erhellen, Vielen Dank erstmal für eure Zeit des Lesens 😉

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Public Sub aaa() Dim i As Long Application.ScreenUpdating = False With Worksheets("Tabelle1") For i = 3 To 8 If .Cells(10, i) = 0 Then Union(.Range(.Cells(11, i), .Cells(39, i)), .Range(.Cells(46, i), .Cells(66, i)), _ .Range(.Cells(68, i), .Cells(85, i)), .Range(.Cells(92, i), .Cells(112, i))). _ ClearContents End If Next i End With End Sub

Hallo Werner, vielen Dank für deine Antwort
Das Blatt um das es sich handelt, beinhaltet eine Tabelle mit kompletten dünnen Rahmenlinien, in die etwas aus einem anderen Blatt hineinkopiert wird komplett mit Formatierung (Rahmen, Farben, Schrift, Schriftgrösse etc.)
Dabei kann es vorkommen, dass nicht alle Daten gebraucht werden und somit über die Suche nach der 0 (relevante Daten haben keine 0 in Zeile 10) direkt wieder aus den genannten Bereichen gelöscht werden sollen und die Zellen wieder auf ihren normal Zustand gesetzt werden.
Dazu habe ich folgendes im Netz gefunden:

Selection.ClearContents
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With

Durch den Kopiervorgang haut es aber manchmal die Rahmenlinien raus, deshalb sollen die dann in der Prüfung nach der Leerung wieder nachgezeichnet werden.
Dazu hab ich dieses gefunden:

With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With

Nur leider bekomm ich das ganze Absolut nicht zusammengebaut, dafür reicht es bei mir noch nicht.

Public Sub aaa() Dim i As Long Application.ScreenUpdating = False With Worksheets("Tabelle1") For i = 3 To 8 If .Cells(10, i) = 0 Then With Union(.Range(.Cells(11, i), .Cells(39, i)), .Range(.Cells(46, i), .Cells(66, i)), _ .Range(.Cells(68, i), .Cells(85, i)), .Range(.Cells(92, i), .Cells(112, i))).Clear With .Borders(xlInsideHorizontal) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With .Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With End With End If Next i End With End Sub

Sub aaa() Dim i As Long With Worksheets("Tabelle 1") For i = 3 To 8 If .Cells(10, i) = 0 Then With Union(.Range(.Cells(11, i), .Cells(29, i)), .Range(.Cells(46, i), .Cells(65, i)), _ .Range(.Cells(68, i), .Cells(85, i)), .Range(.Cells(92, i), .Cells(109, i))) .ClearContents With .Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With With .Borders(xlInsideHorizontal) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With End With End If Next i End With End Sub

Beliebteste Forumthreads (12 Monate)

Bereiche löschen abhängig von Zahlenwert

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread