|
Hallo, danke für deine rasche Ünterstützung!
Also so schaut mein Worksheet jetzt aus - er führt auch alles korrekt aus, außer das löschen der Zeilen unter Zellen die mit 292-294 anfangen.
Da tut sich einfach gar nichts...
----------
Option Explicit
Option Base 1
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call Test1
Call Zeilenweg
End Sub
____
Sub Test1()
Dim zeile As Long, found As Object, firstaddr As String
With ActiveSheet
.Range("A3") = "Lila"
.Range("B3") = "Blau"
If Range("C3") = "Grün" Then
Columns("C:D").Insert shift:=xlToRight
ElseIf Range("C3") = "Schwarz" Then
Range("C3") = "Lila2"
Range("D3") = "Blau2"
End If
Do
Set found = .Cells.Find(what:="Lila", lookat:=xlWhole, LookIn:=xlValues)
If Not found Is Nothing Then .Columns(found.Column).Delete shift:=xlToLeft
Loop Until found Is Nothing
Do
Set found = .Cells.Find(what:="Blau", lookat:=xlWhole, LookIn:=xlValues)
If Not found Is Nothing Then .Columns(found.Column).Delete shift:=xlToLeft
Loop Until found Is Nothing
Do
Set found = .Cells.Find(what:="Grau", lookat:=xlWhole, LookIn:=xlValues)
If Not found Is Nothing Then .Columns(found.Column).Delete shift:=xlToLeft
Loop Until found Is Nothing
Do
Set found = .Cells.Find(what:="Pink", lookat:=xlPart, LookIn:=xlValues)
If Not found Is Nothing Then .Range(found.Address) = Replace(.Range(found.Address).Text, "KK", "KG")
Loop Until found Is Nothing
End With
Zeilenweg
End Sub
____
Sub Zeilenweg()
Dim zeile, Anfang, erg As Boolean, a
Anfang = Array("292", "293", "294")
For zeile = 1 To WorksheetFunction.Max(Cells(Rows.Count, 1).End(xlUp).Row, _
Cells(Rows.Count, 2).End(xlUp).Row)
erg = False
For Each a In Anfang
If InStr(1, Trim(Cells(zeile, 1)), a) = 1 Then
erg = True
Exit For
End If
Next a
If erg Then
While IsEmpty(Cells(zeile + 1, 1)) And Not IsEmpty((Cells(zeile + 1, 2)))
Rows(zeile + 1).Delete shift:=xlUp
Wend
End If
Next zeile
End Sub
|