Private
Sub
Workbook_open()
Dim
rgG
As
Range, i
As
Double
Set
rgG = Range(
"M1:M400"
)
i = 0
For
Each
C
In
rgG
arrG(i) = C.Value
i = i + 1
Next
End
Sub
Private
Sub
Workbook_SheetActivate(
ByVal
Sh
As
Object
)
If
Sh.Name =
"Eingabe Kundendaten"
Or
Sh.Name =
"Eingabe FM-Dienste"
Or
Sh.Name =
"Listen"
Or
Sh.Name =
"Steuerelemente Angaben"
Or
Sh.Name =
"Basistabelle Instandhalten"
Or
Sh.Name =
"Druckbereiche"
Or
Sh.Name =
"Basistabelle Heizenergie"
Or
Sh.Name =
"VonBisWerte"
Or
Sh.Name =
"Tilgungsplan"
Then
Exit
Sub
Application.EnableEvents =
False
Dim
i
As
Double
, zeile
As
Double
zeile = 0
For
i = 0
To
UBound(arrG)
zeile = i + 1
If
arrG(i) <> Cells(zeile, 13)
Then
If
Cells(zeile, 10) = arrG(i)
Then
arrG(i) = Cells(zeile, 13)
Cells(zeile, 10) = Cells(zeile, 13)
Else
arrG(i) = Cells(zeile, 13)
End
If
End
If
Next
Application.EnableEvents =
True
End
Sub
Private
Sub
Workbook_SheetCalculate(
ByVal
Sh
As
Object
)
If
Sh.Name =
"Eingabe Kundendaten"
Or
Sh.Name =
"Eingabe FM-Dienste"
Or
Sh.Name =
"Listen"
Or
Sh.Name =
"Steuerelemente Angaben"
Or
Sh.Name =
"Basistabelle Instandhalten"
Or
Sh.Name =
"Druckbereiche"
Or
Sh.Name =
"Basistabelle Heizenergie"
Or
Sh.Name =
"VonBisWerte"
Or
Sh.Name =
"Tilgungsplan"
Then
Exit
Sub
Application.EnableEvents =
False
Dim
i
As
Double
, zeile
As
Double
zeile = 0
For
i = 0
To
UBound(arrG)
zeile = i + 1
If
arrG(i) <> Cells(zeile, 13)
Then
If
Cells(zeile, 10) = arrG(i)
Then
arrG(i) = Cells(zeile, 13)
Cells(zeile, 10) = Cells(zeile, 13)
Else
arrG(i) = Cells(zeile, 13)
End
If
End
If
Next
Application.EnableEvents =
True
End
Sub
Private
Sub
Workbook_SheetChange(
ByVal
Sh
As
Object
,
ByVal
Target
As
Range)
If
Sh.Name =
"Eingabe Kundendaten"
Or
Sh.Name =
"Eingabe FM-Dienste"
Or
Sh.Name =
"Listen"
Or
Sh.Name =
"Steuerelemente Angaben"
Or
Sh.Name =
"Basistabelle Instandhalten"
Or
Sh.Name =
"Druckbereiche"
Or
Sh.Name =
"Basistabelle Heizenergie"
Or
Sh.Name =
"VonBisWerte"
Or
Sh.Name =
"Tilgungsplan"
Then
Exit
Sub
Dim
rC
As
Range
Application.EnableEvents =
False
If
Not
Intersect(Target, Range(
"M1:M400"
))
Is
Nothing
Then
For
Each
rC
In
Target
If
rC.Column = 13
Then
If
rC.Offset(0, -3) =
""
Then
rC.Offset(0, -3) = rC
End
If
Next
rC
End
If
If
Not
Intersect(Target, Range(
"J1:J400"
))
Is
Nothing
Then
For
Each
rC
In
Target
If
rC.Column = 10
Then
If
rC =
""
Then
rC = rC.Offset(0, 3)
End
If
Next
rC
End
If
Application.EnableEvents =
True
End
Sub