Automatisches Ausglichen von änderungen VBA
01.12.2014 11:09:58
änderungen
Ich Versuche Das Makro wie in https://www.herber.de/bbs/user/77142.xls
auf eine Tabelle mit 19 Spalten anzuwenden. Es findet auch ein Ausgleich statt nur werden für die Berechnung alle Änderungen heran gezogen, nicht nur die aus der Relevanten Spalte.
Wär super wenn mir jemand helfen kann
lg MAtt
Dim rng As range
Dim dValue As Double
Dim iCounter As Integer
For iCounter = 14 To 48
On Error GoTo ErrExit
Application.EnableEvents = False
If Target(1, 1).Address(0, 0) = Cells(iCounter, 6) Then
If IsNumeric(Target(1, 1)) And Target(1, 1) "" Then
Set rngFix = Nothing
range(Cells(iCounter, 13), Cells(iCounter, 60)).Formula = "=F/E"
Else
range(Cells(iCounter, 13), Cells(iCounter, 60)) = ""
End If
ElseIf Not Intersect(Target, range(Cells(iCounter, 13), Cells(iCounter, 60))) Is Nothing Then
If rngFix Is Nothing Then
Set rngFix = Intersect(Target, range(Cells(iCounter, 13), Cells(iCounter, 60)))
Else
Set rngFix = Union(rngFix, Intersect(Target, range(Cells(iCounter, 13), Cells(iCounter, 60))))
End If
For Each rng In range(Cells(iCounter, 13), Cells(iCounter, 60))
If rng.HasFormula Then
rng.Formula = "=($F" & iCounter & "-" & (WorksheetFunction.Sum(rngFix)) & ")/" & WorksheetFunction.Max(1, 19 - rngFix.Count)
End If
Next
End If
Next iCounter
ErrExit:
Application.EnableEvents = True
End Sub