VBA Makro gesucht: Inhalt von Zellen löschen wenn eine andere Zelle bestimmten "TEXT" beinhalted?
Hallo Zusammen,
ich bin absoluter VBA neuling, bräuchte aber ein einfaches Makro zu folgendem Fall:
In den Zellen der Spalte R (R6:R150) steht entweder: "STATUS1=grün" oder "STATUS2=gelb" oder "STATUS3=rot".
-
Wenn zum Beispiel Zelle R6 = "STATUS1=grün" dann sollen die Zellen (I6:J6) und die Zellen (L6:N6) geleert werden
-
Wenn R6 = "STATUS2=gelb" dann sollen die Zellen (I6:J6) geleert werden
-
Wenn R6 = "STATUS3=rot" dann soll nichts gelöscht werden.
-
Wenn R6 = "" (also leer) soll auch nicht gelöscht werden.
--> Gleiches soll für alle Zelle im Bereich (R6:R150) gelten
--> Die Spalten I,J,L,M und N müssen aber befüllbar sein, daher lässt sich das ja nicht über eine Formel machen.
Das ist alles was ich bis jetzt zusammen gebastelt habe: leider funktioniert es nicht:
Private Sub Worksheet_Change(ByVal Target As Range)
'Abfrage, ob Änderung in Zelle A1 erfolgt ist
If Target.Address = "$R$6" Then
If IsValue(STATUS1 = grün) Then
Range("4:F14").Select
Selection.ClearContents
End Select
End If
End SubVielen Dank für eure Hilfe.
4 Antworten
Probiere mal das hier:
Sub NobyTree2()
Dim x, y As Integer
For x = 1 To 150
If Cells(x, 18).Value = "STATUS1=grün" Then
For y = 9 To 10
Cells(x, y).Value = ""
Next y
For y = 12 To 14
Cells(x, y).Value = ""
Next y
End If
If Cells(x, 18).Value = "STATUS2=gelb" Then
For y = 9 To 10
Cells(x, y).Value = ""
Next y
End If
Next x
End Sub
Sorry, einfacher mit Range.Clear
Sub NobyTree2()
Dim x, y As Integer
For x = 1 To 150
If Cells(x, 18).Value = "STATUS1=grün" Then
Range(Cells(x, 9), Cells(x, 10)).Clear
Range(Cells(x, 12), Cells(x, 14)).Clear
End If
If Cells(x, 18).Value = "STATUS2=gelb" Then
Range(Cells(x, 9), Cells(x, 10)).Clear
End If
Next x
End Sub
Wenn ich den Befehl ausführe friert mein Excel ein ... :D
Mit IsValue habe ich keine Erfahrung. Ich würde herkömmlich If Target.Value = "STATUS1 = grün" Then abfragen.
Das .Select kannst du dir schenken. Anstelle dessen kannst du schreiben:
Range("I6:J6").ClearContents
Range("L6:N6").ClearContents
Die letzte Herausforderung besteht darin, das über alle Zeilen von 6 bis 150 laufen zu lassen.
Baue eine For Schleife darum:
Dim i As Integer
For i=6 To 150
...
Next
Deine Befehle, in denen du dich auf Zeile 6 beziehst, änderst du so ab. Beispiel:
Range("I" & i & ":J" & i).ClearContents
Normalerweise müsste ein Fehler kommen "If Block ohne End If".
Du hast zwei Ifs, aber nur ein End If.
Ansonsten müsste es laufen. Hast du das Ereignis auch am richtigen Sheet stehen?
PS: Der Kommentar passt längst nicht mehr ;)
Ja richtig! Hat doch funktioniert!!! Jetzt muss ich nur noch die anderen bedinungen integrieren.
Private Sub Worksheet_Change(ByVal Target As Range)
'Abfrage, ob Änderung in Zelle A1 erfolgt ist
Dim i As Integer
For i = 6 To 150
If Target.Address = "$R$6" Then
If Target.Value = "STATUS1=grün" Then
Range("I6:J6").ClearContents
Range("L6:N6").ClearContents
End If
ElseIf Target.Value = "STATUS2=gelb" Then
Range("L6:N6").ClearContents
End If
Next
End Sub
Er meldet aber: Laufzeitfehler '13': Typen unverträglichkeit.
Du hast immer noch ein End If zuwenig. 3 Ifs, 2 End Ifs.
Probier mal folgendes:
Private Sub Worksheet_Change(ByVal Target As Range)
'Abfrage, ob Änderung in Spalte R erfolgt ist
Dim i As Integer
For i = 6 To 150
If Target.Address = "$R$" & i Then
If Target.Value = "STATUS1=grün" Then
Range("I" & i & ":J" & i).ClearContents
Range("L" & i & ":N" & i).ClearContents
End If
If Target.Value = "STATUS2=gelb" Then
Range("L" & i & ":N" & i).ClearContents
End If
End If
Next
End Sub
Perfekt TAUSEND DANK !!!! ES FUNKTIONIERT!!! :-
Kommando zurück. ElseIf hättest du auch so lassen können.
Ich müsste nochmal revidieren ...Wieso oft zeigen sich einige Probleme erst bei der Anwendung.
Beispiel: Ich möchte nur dass die Felder I10:J10 und L10:N10 geleert werden, wenn in Feld R10 vorher STATUS2=gelb stand und durch STATUS1=grün ersetzt wurde.
--> wenn R10allt = R10neu dann soll nichts passieren.
--> dabei muss das makro aber jedes Feld in spalte R für sich checken und dann entscheiden ob es eine löschung durchführt
Ist sowas einfach möglich oder ist das eine größere operation? :-)
Vielen Dank für die Unterstützung!
Beim Öffnen der Arbeitsmappe und nach jedem Ändern einer Zelle der Spalte R könntest du die Werte der Spalte R in einen versteckten Bereich kopieren.
Beim Ändern einer Zelle vergleichst du den aktuellen Inhalt dann mit dem Wert in der versteckten Spalte.
Nur auf Papier geschrieben und nicht getestet:
For Ze = 6 To 150
Inh=Cells (Ze, 18).Value
If InStr (1, Inh, "grün") <>0 Then
Range("I6:J6").ClearContent
Cells (Ze, 12).ClearContent
Cells (Ze, 14).ClearContent
ElseIf InStr (1, Inh, "gelb") <>0 Then
Range("I6:J6").ClearContent
End If
Next
das Cells ist falsch ... ersetze es durch Range(Cells (Ze,12), Cells (Ze,14)).ClearContent und für das andere Range (in beiden Fällen) Range(Cells (Ze,9), Cells (Ze,10)).ClearContent
Vielen Dank schonmal für die schnelle Antwort.
Habe jetzt versucht schonmal das erste umzusetzen, um ersmal nur die Zelle R6 aubzuprüfen:
Leider passiert gar nichts :( Müsste doch eigentlich für die Zeile 6 schon funktionieren oder ?