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
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
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]
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
(04.10.2021, 09:17)Gast 123 schrieb: [ -> ]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 :)
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)
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
(04.10.2021, 18:42)Sorry, ich habe meinen Gedankenfehler jetzt durch das Beispiel verstanden. Teste es bitte mal so. Nur den Teil VOR Set ändern!!
mfg Gast 123
Gast 123 schrieb: [ -> ]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)
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
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
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.