Zwei Varianten: Change und Calculate
23.09.2010 19:55:03
Erich
Hi Ralf,
probier diese beiden Varianten mal aus. Kannst du eine davon verwenden? Wenn ja, welche?
Hier der Code - je einer für eine Tabelle:
Option Explicit
Private Sub Worksheet_Calculate()
Static AltF4 As Double
If Not IsNumeric(Cells(4, 6)) Then Exit Sub
If IsEmpty(Cells(4, 2)) Or IsEmpty(Cells(4, 4)) Then
AltF4 = Cells(4, 6).Value
Else
Application.EnableEvents = False
If AltF4 Cells(4, 6).Value Then
AltF4 = Cells(4, 6).Value
Select Case Int(Cells(4, 6).Value)
Case Is 20
Cells(27, 2) = Cells(27, 2) + 1
Case Else
Cells(AltF4 + 6, 2) = Cells(AltF4 + 6, 2) + 1
End Select
End If
Application.EnableEvents = True
End If
End Sub
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim dblErg As Double
If Intersect(Target, Union(Cells(4, 2), Cells(4, 4))) Is Nothing Then Exit Sub
If IsEmpty(Cells(4, 2)) Or IsEmpty(Cells(4, 4)) Then Exit Sub
If Not IsNumeric(Cells(4, 6)) Then Exit Sub
dblErg = Int(Cells(4, 6).Value)
Application.EnableEvents = False
Select Case dblErg
Case Is 20
Cells(27, 2) = Cells(27, 2) + 1
Case Else
Cells(dblErg + 6, 2) = Cells(dblErg + 6, 2) + 1
End Select
Application.EnableEvents = True
End Sub
Und hier die BeiSpielMappe: dazu: https://www.herber.de/bbs/user/71639.xls
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
P.S.: Deine Antwort auf meine Frage:
"sind also B10, B16, B18 und B21 um je 1 erhöht worden. Soll das so geschehen?"
wäre dann wohl "JA" gewesen.