WENN neuer Wert bereits vorhanden DANN lösche diesen und ZÄHLE +1 in anderer Zelle

[master2011]

Moin,

ich arbeite mit einem QR Code scanner.

Wenn ich nun die Codes einscanne (Beginnend ab D4 nach unten), möchte ich, dass wenn ich einen Wert scanne, welcher bereits vorhanden ist,
dass diese Zelle gleich wieder gelöscht wird, und die Anzahl derer dann +1 addiert wird (in dem Falle dann C4)

(hier am Beispiel "Dose")

[
Bild bitte so als Datei hochladen: Klick mich!
]

Da hat doch bestimmt einer ne schnelle Lösung für mich 

[Gast 123]

Hallo

bitte mal ausprobieren ob es mit diesem Code klappt. Er gehört in das Blatt wo gescannt wird!  (NICHT in ein Modul!!)

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rFind As Range
On Error GoTo Fehler
If InStr(Target.Address, ":") Then Exit Sub
If Target.Value = Empty Then Exit Sub
If Target.Column <> 4 Then Exit Sub

    Set rFind = Columns(4).Find(What:=Target, After:=[d1], LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
    If Not rFind Is Nothing Then
    If rFind.Address <> Target.Address Then
       rFind.Offset(0, -1) = rFind.Offset(0, -1) + 1
       Target.Select:  Target.Value = ""
    End If
    End If
Exit Sub

Fehler:  MsgBox "unerwarteter Targetfehler"
End Sub

mfg Gast 123

[master2011]

Vielen Dank genau so hatte ich mir das vorgestellt :)
Wenn ich nun allerdings den ersten Artikel scanne zählt er diesen nicht. Das heißt die Zählung beginnt bei 0"



Hallo

bitte mal ausprobieren ob es mit diesem Code klappt. Er gehört in das Blatt wo gescannt wird!  (NICHT in ein Modul!!)

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rFind As Range
On Error GoTo Fehler
If InStr(Target.Address, ":") Then Exit Sub
If Target.Value = Empty Then Exit Sub
If Target.Column <> 4 Then Exit Sub

    Set rFind = Columns(4).Find(What:=Target, After:=[d1], LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
    If Not rFind Is Nothing Then
    If rFind.Address <> Target.Address Then
       rFind.Offset(0, -1) = rFind.Offset(0, -1) + 1
       Target.Select:  Target.Value = ""
    End If
    End If
Exit Sub

Fehler:  MsgBox "unerwarteter Targetfehler"
End Sub

mfg Gast 123
[/quote]

[Gast 123]

Hallo

freut mich das mein Makro zufriedenstellend klappt. Wenn es die erste Zelle D1 "schlabbert" können wir nachbessern. Ich ging von einer Überschriftszeile aus.  Setze  bitte VOR Set diese Zeile:
If target.Value = Cells(1, 4) Then Cells(1, 4) = Cells(1, 4) + 1: Exit Sub
Mit dem Befehl sollte die erste Zelle D1 seperat ausgewertet werden. Bin gespannt ob es klappt.

mfg  Gast 123

[master2011]

Hallo

freut mich das mein Makro zufriedenstellend klappt. Wenn es die erste Zelle D1 "schlabbert" können wir nachbessern. Ich ging von einer Überschriftszeile aus.  Setze  bitte VOR Set diese Zeile:
If target.Value = Cells(1, 4) Then Cells(1, 4) = Cells(1, 4) + 1: Exit Sub
Mit dem Befehl sollte die erste Zelle D1 seperat ausgewertet werden. Bin gespannt ob es klappt.

mfg  Gast 123

Das hat er leider nicht gefressen, also leider immernoch wie bisher. Also die Zählung startet bei 0

Habe mal die Excel Datei mit angehängt :)

[Gast 123]

Hallo

Sorry, ich habe meinen Gedankenfehler jetzt durch das Beispiel verstanden. Teste es bitte mal so. Nur den Teil VOR Set ändern!!

mfg Gast 123

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rFind As Range
On Error GoTo Fehler
If InStr(Target.Address, ":") Then Exit Sub
If Target.Value = Empty Then Exit Sub
If Target.Column <> 4 Then Exit Sub
   
    If Target.Address = "$D$4" Then
       Target.Offset(0, 1) = 1: Exit Sub
    End If
   
    Set rFind = Columns(4).Find(What:=Target, After:=[d3], LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)

[master2011]

Leider nein,auch bei diesem Code bleibt das Ergebnis unverändert.Ich Tippe den Artikel ein, die Anzahl bleibt leertippe ich den nächsten Artikel ein, addiert sich das leere Feld auf 001 usw.
Hallo

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rFind As Range
On Error GoTo Fehler
If InStr(Target.Address, ":") Then Exit Sub
If Target.Value = Empty Then Exit Sub
If Target.Column <> 4 Then Exit Sub
   
    If Target.Address = "$D$4" Then
       Target.Offset(0, 1) = 1: Exit Sub
    End If
   
    Set rFind = Columns(4).Find(What:=Target, After:=[d3], LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)

[Gast 123]

Hallo

in dem hochgeladenen Besipiel läuft dieser Code einwandfrei. Neu eingefügt habe ich nur das Zurücksetzen auf Null wenn Zelle D4 gelöscht wird.
Im letzten Code den ich gesendet habe fehlte offenbar das "-" Zeichen bei Offset(0, 1).  Probier bitte diese Variante mal aus.

mfg  Gast 123

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rFind As Range
On Error GoTo Fehler
If InStr(Target.Address, ":") Then Exit Sub
If Target.Column <> 4 Then Exit Sub
   
    If Target.Address = "$D$4" Then
       If Target.Value = "" Then
          Target.Offset(0, -1) = 0
       Else
          Target.Offset(0, -1) = 1:
       End If
       Target.Select: Exit Sub
    End If
   
    Set rFind = Columns(4).Find(What:=Target, After:=[d3], LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
    If Not rFind Is Nothing Then
    If rFind.Address <> Target.Address Then
       rFind.Offset(0, -1) = rFind.Offset(0, -1) + 1
       Target.Select:  Target.Value = ""
    End If
    End If
Exit Sub

Fehler:  MsgBox "unerwarteter Targetfehler"
End Sub

[master2011]

Ich korrigiere mich:

also es funktioniert tatsächlich, allerdings auch nur für die Zelle D4 
aber das selbe sollte ja auch für alle nachfolgenden Zellen passen. Also wenn ich zum Beispiel schon 7 Artikel habe dann wäre dann die Zelle D11 jene welche bei 1 anfangen sollte zu zählen 

[Gast 123]

Hallo

tja, wenn man den Scanner nicht selbst in der Hand hat kommt man nicht auf die Nächstliegende Funktionen. Obwohl sie logisch sind.
Nehmen wir es gelassen mit Humor.  Ich bin dafür bekannt meine Makros solange zu korrigieren bis sie einwandfrei laufen.

mfg  Gast 123

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rFind As Range
On Error GoTo Fehler
If InStr(Target.Address, ":") Then Exit Sub
If Target.Column <> 4 Then Exit Sub
   
If Target.Value <> Empty Then
    'Suce ob Artikel bereits vorhanden ist?
    Set rFind = Columns(4).Find(What:=Target, After:=[d3], LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
    'Bei "Ja" gefundene Zelle addieren, Target löschen
    If Not rFind Is Nothing Then
    If rFind.Address <> Target.Address Then
       rFind.Offset(0, -1) = rFind.Offset(0, -1) + 1
       Target.Select:  Target.Value = ""
       Exit Sub
    End If
    End If
End If

    'Leere Zellen auf 0 setzen
    If Target.Value = Empty Then
       Target.Offset(0, -1) = 0
       Target.Select
    ElseIf Target.Offset(0, -1) = 0 Then
    'Nicht leere Zellen ggf. aif 1 setzen  (Nicht überschreiben)
       Target.Offset(0, -1) = 1
       Target.Offset(1, 0).Select
    End If
Exit Sub

Fehler:  MsgBox "unerwarteter Targetfehler"
End Sub

---

Nachtrag:  bei einer neuen Eingabe mit 1 schaltet das Makro jetzt de Cursor automatisch eine Zeile tiefer.