AW: unklare Aufgabenstellung
26.03.2009 13:53:15
Jaffi
So Specke, nun bin ich mit meinem Latein am Ende. Kopf platzt und ich stehe vor einem riesen Fragezeichen :(
Ich hätte dazu sagen sollen, das auf meinem Sheet schon eine Prozedur mit der gleichen Bezeichnung läuft..
Diese befüllt mir nacheinander die Spalte B mit Seriennummern und Schreibt ein Datum daneben.
Die Kontrollfelder B2 (übrigens nicht B4 :o/) und B1 müssen dann wohl in ein und die selbe Prozedur rein...logisch!! :( man was hab ich mir da nur angetan *grummel*
Bekommt man folgende Zwei Prozeduren irgendwie zusammen in eine? Ich hab schon alles durchprobiert aber ich weis einfach noch zu wenig über VBA:
UND in den unten genannten Code fehlt mir ja noch das anfangs erwähnte 2 Kontollfeld B1-Dieses soll ja auch die Spalte B überprüfen. Wenn Zeichensatz vorhanden ein "verkauft" in die Spalte A daneben schreiben. Wenn nicht vorhanden einfach nur msgbox und nichts weiter....
Specke geb ich jetzt auf und knie vor meinem Chef nieder?
Würde lieber vor Deiner Hilfe niederknien :(
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row >= 4 And Target.Column = 2 And Target.Value "" Then
Application.EnableEvents = False
If Target.Value Like "A?ZED" Then
Target.Offset(0, 1).Value = Now
Else
Beep
Target.Value = ""
Target.Cells.Select
End If
Application.EnableEvents = True
End If
End Sub
----------------------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
gefunden = False
With Worksheets(1)
'wenn Zelle B2 verändert wurde
If Target.Address = "$B$2" Then
If Left(.Range("B2").Value, 1) = "A" And Len(.Range("B4").Value) = 15 And Right(.Range("B4"). _
_
Value, 3) = "ZED" Then
'von Zeile 4 bis zur letzten benutzen Zeile von Spalte B
For i = 4 To .Cells(Rows.Count, 2).End(xlUp).Row
'wenn der Wert in Spalte B der aktuell durchsuchten Zeile gleich dem Wert in B2 ist
If .Range("B" & i).Value = .Range("B2").Value Then
'schreibe in Spalte A der durchsuchten Zeile "erfasst"
.Range("A" & i).Value = "erfasst"
'Variable "gefunden" setzen
gefunden = True
'Suche beenden
Exit For
End If
'nächste Zeile
Next i
'wenn kein Wert gefunden wurde (Variable "gefunden" wurde nicht gesetzt)
If gefunden = False Then
'wenn eingeblendete Msgbox mit "ja" beantwortet wird
If MsgBox("Datensatz nicht gefunden. Eintragen?", vbYesNo) = vbYes Then
'schreibe den Wert aus B2 in die erste freie Zeile in Spalte B
.Range("B" & .Cells(Rows.Count, 2).End(xlUp).Row + 1).Value = .Range("B4").Value
'schreibe "Neueintrag" in die gleiche Zeile in Spalte A
.Range("A" & .Cells(Rows.Count, 2).End(xlUp).Row).Value = "Neueintrag"
End If
End If
Else
MsgBox "Keine gültige Seriennummer"
End If
'Events deaktivieren (sonst Endlosschleife)
Application.EnableEvents = False
'Inhalt aus Zelle B2 löschen
.Range("B2").Value = ""
'Zelle B2 auswählen
.Range("B2").Select
'Events aktivieren (sonst funktioniert kein Makro mehr)
Application.EnableEvents = True
End If
End With
End Sub