HILFE bei Additions-Makro!! - 2.Versuch ...

Hallo Freunde!
Mit dem u. a. Makro kann man die Inhalte der Zellen B6 bis B9 und C6 bis C9 durch Eingabe eines Zahlenwertes mit dem in der jeweiligen Zelle vorhandenen Wert addieren.
*****************************************************************
Dim oldvalue(18) As Double
Dim speich As Boolean


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Cells.Count > 1 Then Exit Sub
On Error GoTo fixit
Application.EnableEvents = False
Select Case Target.Address(0, 0)
Case "B6", "B7", "B8", "B9"
Range("B" & Target.Row) = Range("B" & Target.Row) + oldvalue(Target.Row - 5)
oldvalue(Target.Row - 5) = Range("B" & Target.Row)
Case "C6", "C7", "C8", "C9"
Range("C" & Target.Row) = Range("C" & Target.Row) + oldvalue(Target.Row + 5)
oldvalue(Target.Row + 5) = Range("C" & Target.Row)
End Select
fixit:
Application.EnableEvents = True
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If speich = True Then Exit Sub
With Worksheets("Zeit")
For n = 1 To 18
If n <= 9 Then
oldvalue(n) = .Cells(n + 5, 2)
Else
oldvalue(n) = .Cells(n - 5, 3)
End If
Next n
End With
speich = True
End Sub

Sub WennNixMehrPassiert()
Application.EnableEvents = True
End Sub
********************************************************
Mein Problem:
Wie kann man diese Formel so umschreiben, daß diese automatische Addition in weiteren Zellen möglich wird?
Ich muß zum Beispiel folgende Bereiche derartig berechnen:
B6 - B36
F6 - F36
J6 - J36
N6 - N36
R6 - R36
C6 - C36
G6 - G36
K6 - K36
O6 - O36
S6 - S36
Kann mir jemand wieder helfen ?
Danke an alle, die sich meines Problems annehmen :-))
Gruß
Stephan

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count <> 1 Then Exit Sub If Not Intersect(Target, [B6:B36,C6:C36,F6:F36,G6:G36,J6:J36,K6:K36,N6:N36,O6:O36,S6:S36,R6:R36]) Is Nothing Then Application.EnableEvents = False If Target = "" Then oldVal = 0 If IsNumeric(Target) And Target <> "" Then Target = Target + oldVal Application.EnableEvents = True End If End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count <> 1 Then Exit Sub If Not Intersect(Target, [B6:B36,C6:C36,F6:F36,G6:G36,J6:J36,K6:K36,N6:N36,O6:O36,S6:S36,R6:R36]) Is Nothing Then If IsNumeric(Target) Then oldVal = Target Else oldVal = 0 End If End If End Sub

Beliebteste Forumthreads (12 Monate)

HILFE bei Additions-Makro!! - 2.Versuch ...

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread