Einträge zählen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("B1")) Is Nothing Then Dim Wert$, x& Wert = Target.Value For x = 7 To 25 If Cells(x, 1) = Wert Then Cells(x, 2) = Cells(x, 2) + 1 Next End If End Sub

Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("B1")) Is Nothing Then Dim Wert$, x& Wert = Target.Value For x = 7 To 25 'If Cells(x, 2) = Wert Then Cells(x, 2) = Cells(x, 2) + 1 If Cells(x, 2) = Wert Then Cells(x, 2) = Cells(x, 2) + Range("C1").Value 'Multiplicator in _ C1 Next End If With Range("B1") .ClearContents .Select End With Range("C1").Value = 1 '1 soll der Standardeintrag des Multiplikators sein End Sub

Hallo Dietmar,
beim Barcodescanner-Thema steige ich mal mit ein :-)
dass das Change-Ereignis immer eintritt,
Das stimmt so nur bedingt. Über-Pendantisch müsste man sagen, dass das Change-Ereigniss eh immer eintritt, und dann nur Codezeilen je nach target ausgeschlossen werden -- aber es ist ja klar wie du das meinst.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B1")) Is Nothing Then
Dim Wert$, x&
Wert = Target.Value
For x = 7 To 25
'If Cells(x, 2) = Wert Then Cells(x, 2) = Cells(x, 2) + 1
If Cells(x, 2) = Wert Then Cells(x, 2) = Cells(x, 2) + Range("C1").Value  'Multiplicator in   _
_
C1
Next
End If
With Range("B1")
.ClearContents
.Select
End With
Range("C1").Value = 1   '1 soll der Standardeintrag des Multiplikators sein
End Sub

Der erste Teil deines Codes ist in einem intersect-IF Block und wird ausgeschlossen, wenn deine Zelle nicht B1 ist (fett).
Der zweite Teil (den meinst du mit "tritt immer ein" ist ausserhalb dieses Blocks! Wenn auch der nur bei Change von B1 eintreten soll, dann nimm ihn mit in den Block! Einfach das EndIf verschieben, sieht dann so aus:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B1")) Is Nothing Then
Dim Wert$, x&
Wert = Target.Value
For x = 7 To 25
'If Cells(x, 2) = Wert Then Cells(x, 2) = Cells(x, 2) + 1
If Cells(x, 2) = Wert Then Cells(x, 2) = Cells(x, 2) + Range("C1").Value  'Multiplicator  _
in C1
Next
With Range("B1")
.ClearContents
.Select
End With
Range("C1").Value = 1   '1 soll der Standardeintrag des Multiplikators sein
End If
End Sub

Jetzt wird der gesamte Code nur ausgeführt, wenn du B1 änderst.
OFFTOPIC:
Dieser Codeteil:

For x = 7 To 25
If Cells(x, 2) = Wert Then Cells(x, 2) = Cells(x, 2) + Range("C1").Value
Next

ge
fällt mir überhaupt nicht. Ich behaupte, dass geht auch ohne Schleife! Kannst du bitte mal deine Datei hochladen?
Grüße,
Klaus M.vdT.

Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("B1")) Is Nothing Then If Target "" And IsNumeric(Target) Then Dim Wert$, x& Wert = Target.Value For x = 7 To 25 If Cells(x, 1).Value = Wert Then Cells(x, 2).Value = Cells(x, 2) + Cells(1, 3) Next End If End If Range("B1").ClearContents End Sub

Hallo Matthias,
ich habe die Datei mal weiterentwickelt. Deine Ansätze sind genau das, was ich brauche.
Nun ist es aber so, dass die Codenummern, die es zu berechnen gilt, nicht in einer Spalte, sondern
in drei Spalten sein werden (habe die Datei mal erweitert).
Deshalb war anfangs ja meine Frage, ob man mit NAMEN arbeiten kann; damit könnte man den zu prüfenden
Bereich ja einfach angeben (so etwa: X = Name CodeNr)
Schau mal in den VBA-Bereich, habe dort Anmerkungen hineingeschrieben.
Mein Versuch, die drei Spalten mit weiteren If-Prüfungen abzufragen ist gescheitert (grrr).
https://www.herber.de/bbs/user/86436.xls
Ferner habe in eine zweite Intersect-Prüfung eingebaut, die den Multiplikator betrifft, funktioniert auch :-)
Vielen Dank
LG
Dietmar

Beliebteste Forumthreads (12 Monate)

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread