Zellen bei Bedingung löschen
11.09.2006 16:53:19
Sven
Wie in nachstehendem Code abgebildet, wird bei einen kleineren oder gleichen Wert in Spalte 9 eine Kopierfunktion gestartet. Wenn dieser Wert bereits vorhanden ist, soll er in der Tabelle "Bestellung" überschrieben werden.
Jetzt möchte ich es zusätzlich umkehren: wenn der Wert in Spalte 9 wieder größer ist und in der Tabelle "Bestellung" bereits vorhanden, dann soll diese Zeile wieder gelöscht werden.
Ich habe da schon mal etwas holflos rumgedoktort.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error GoTo ende
Sheets("Bestand").Unprotect Password:="Sommer12"
If Target.Column = 11 Then Cells(Target.Row, Target.Column - 2) = Cells(Target.Row, Target.Column - 2) + Target.Value 'Zugang
If Target.Column = 12 Then Cells(Target.Row, Target.Column - 3) = Cells(Target.Row, Target.Column - 3) - Target.Value 'Abgang
If Cells(Target.Row, 9) <= Cells(Target.Row, 10) Then
With Sheets("Bestellung")
Bestellnummer = Cells(Target.Row, 7)
Set c = .Columns(1).Find(What:=Bestellnummer, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
c(1, 5) = Cells(Target.Row, 8) - Cells(Target.Row, 9) 'wenn Bestellnummer bereits vorhanden, dann Wert überschreiben
Else
lz = .Cells(Rows.Count, 1).End(xlUp).Row + 1 ' Reihen jeweils um 1 erweitern
.Cells(lz, 1) = Cells(Target.Row, 7) 'kopiert Artikelnummer nach Bestellung in Spalte 1
.Cells(lz, 2) = Cells(Target.Row, 3) 'kopiert Warengruppe nach Bestellung in Spalte 2
.Cells(lz, 3) = Cells(Target.Row, 4) 'kopiert Artikelname nach Bestellung in Spalte 3
.Cells(lz, 4) = Cells(Target.Row, 5) 'kopiert Inhalt nach Bestellung in Spalte 4
.Cells(lz, 5) = Cells(Target.Row, 8) - Cells(Target.Row, 9) 'Differenz aus Soll-Ist in Spalte 5
End If
End With
End If
---hier ist mein Versuch ----
If Cells(Target.Row, 9) > Cells(Target.Row, 10) Then
With Sheets("Bestellung")
Bestellnummer = Cells(Target.Row, 7)
Set c = .Columns(1).Find(What:=Bestellnummer, LookIn:=xlValues, LookAt:=xlWhole)
If c Is Nothing Then
.Row.Delete (c)
End If
End With
End If
If Cells(Target.Row, 11) <> "" Then Cells(Target.Row, 11) = "" 'nach Zugang Zelle leeren
If Cells(Target.Row, 12) <> "" Then Cells(Target.Row, 12) = "" 'nach Abagng Zelle leeren
ende:
Sheets("Bestand").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="Sommer12"
End Sub