2 Felder vergelichen und ein drittes um 1 erhöhen

Hallo zusammen, ich bin gerade händeringend auf der Suche nach eine Lösung für folgende Anforderung.
Die Mitglieder meines Vereines sollen eine Art Clubkarte mit einem Barcode bekommen. Bei unseren Veranstaltungen können sie damit vergünstigte Getränke erhalten. Hierzu soll der Barcode abgesacannt werden und EIN Feld "Anzahl" um den Wert 1 erhöht werden. Meine Idee war nun: Ein "Scanfeld" zu erzeugen; ist nun dieser Wert (vom Scanner eingelesen) gleich wie die ID irgendeines Mitglieds, so wird in der enstsprechen Zeile in der Spalte "Anzahl" der Wert um 1 erhöht. Im Klartext wird mit jedem Scan dem entsprechenden Mitglied ein Getränk dazugebucht. Soweit die Theorie ;-) Hat hierfür jemand eine Idee, bzw. natürlich auch Optimierungsvorschläge? Viele Grüße Jesco

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo
ich hab mal was ähnliches von mir auf deine Bedürfnisse abgeändert.
Bei Änderungen in A1 = Scanfeld startet das Makro
Ich verwende einen Scanner, der parallel zur Tastatur verwendet wird. D.h. du kannst scannen oder per Tastatur eingeben.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1")) Is Nothing Then 'Scanfeld =A1
On Error GoTo Fehler
Application.EnableEvents = False
Dim SP%, c, LA&, JN
SP = 4 'Mitglieder in Salte D / Anzahl in E   *** ändern
With Columns(SP)
Set c = .Find(What:=Target.Value, LookIn:=xlValues)
If Not c Is Nothing Then
'bereits vorhanden
Cells(c.Row, SP + 1) = Cells(c.Row, SP + 1) + 1
Else
'ist neu
JN = MsgBox("Neues Mitglied." & Chr(13) & Chr(13) & "Anlegen?", vbYesNo +  _
vbQuestion, "Mitgliederverwaltung")
If JN = 6 Then 'neu anlegen
LA = ActiveSheet.Cells(Rows.Count, SP).End(xlUp).Row + 1
Cells(LA, SP) = Target.Value
Cells(LA, SP + 1) = 1
'sortieren
With Me.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("D2:D" & LA _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
.SetRange Range("D1:E" & LA)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Else
MsgBox "Nicht angelegt", vbOKOnly + vbExclamation, "Mitgliederverwaltung"
End If
End If
Target.Value = "" 'Scanfeld wieder löschen
Target.Select
End With
End If
Fehler:
If Err.Number  0 Then MsgBox "Fehler: " & Err.Number & " " & Err.Description
Application.EnableEvents = True
End Sub

Gruß UweD
https://www.herber.de/bbs/user/81862.xlsm

Beliebteste Forumthreads (12 Monate)

2 Felder vergelichen und ein drittes um 1 erhöhen

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2 Felder vergelichen und ein drittes um 1 erhöhen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread