Re: Funktionen
15.12.2002 22:48:21
Hajo_zi
Hallo Wolfgangich würde den code wie folgt einkürzen.
Option Explicit
Function AbfangKonsole(Wandart, anz, dicke, länge, höhe, AchsAbst, Raster)
Dim Überbau, überlänge, end_achse As Variant
Dim Anz_konsole, Anz_achsen As Double
Application.Volatile
If Wandart = "Wand" Then
Select Case dicke
'***************************************************************
Case 125
If höhe < 12 Then
Anz_konsole = 0
end_achse = 0
ElseIf höhe >= 12 Then
Select Case AchsAbst
Case Is <= 4
Anz_konsole = Überbau / 5.13
Case Is <= 5
Anz_konsole = Überbau / 4.11
End Select
Überbau = höhe - 12
end_achse = 1
End If
'***************************************************************
Case 150
If höhe < 12 Then
Anz_konsole = 0
end_achse = 0
ElseIf höhe >= 12 Then
Select Case AchsAbst
Case Is <= 4
Anz_konsole = Überbau / 5.46
Case Is <= 5
Anz_konsole = Überbau / 4.37
Case Is <= 5.5
Anz_konsole = Überbau / 3.97
Case Is <= 6
Anz_konsole = Überbau / 4.64
End Select
Überbau = höhe - 12
end_achse = 1
End If
'***************************************************************
Case 175
If höhe < 14 Then
Anz_konsole = 0
end_achse = 0
ElseIf höhe >= 14 Then
Select Case AchsAbst
Case Is <= 4
Anz_konsole = Überbau / 6.19
Case Is <= 5
Anz_konsole = Überbau / 4.95
Case Is <= 5.5
Anz_konsole = Überbau / 4.5
Case Is <= 6
Anz_konsole = Überbau / 4.13
Case Is <= 6.5
Anz_konsole = Überbau / 3.81
Case Is <= 7
Anz_konsole = Überbau / 3.54
End Select
Überbau = höhe - 14
end_achse = 1
End If
'***************************************************************
Case Is = 200
If höhe < 16 Then
Anz_konsole = 0
end_achse = 0
ElseIf höhe >= 16 Then
Select Case AchsAbst
Case Is <= 4
Anz_konsole = Überbau / 5.42
Case Is <= 5
Anz_konsole = Überbau / 4.34
Case Is <= 5.5
Anz_konsole = Überbau / 3.94
Case Is <= 6
Anz_konsole = Überbau / 3.61
Case Is <= 6.5
Anz_konsole = Überbau / 3.33
Case Is <= 7
Anz_konsole = Überbau / 3.1
Case Is <= 7.5
Anz_konsole = Überbau / 2.89
End Select
Überbau = höhe - 16
end_achse = 1
End If
End Select
'***************************************************************
End If
Anz_achsen = länge / AchsAbst
Anz_achsen = WorksheetFunction.RoundUp(Anz_achsen, 0)
AbfangKonsole = (WorksheetFunction.RoundUp(Anz_konsole, 0) * (Anz_achsen + end_achse))
End Function
Code eingefügt mit: Excel Code Jeanie
Code Jeanie
Frage
Das Umsetzen nach Html klappt perfekt, auch die Ansicht in den Foren ist gegeben. Bei manchen Foren kann man aber anscheinend nicht den dargestellten Code nach VBA rückkopieren. Warum?
Antwort
Dies liegt nicht an der Code Jeanie !!! Manche Foren interpretieren anscheinend < pre > < /pre > Tags nicht richtig und erzeugen am Zeilenende einen weichen Zeilenumbruch anstatt eines harten Zeilenumbruches. Dies führt dazu, dass im VBA-Editor die Zeilen hintereinander geschrieben werden. Zum Rückkopieren in solchen Fällen: Fügen Sie den kopierten Code aus dem Forum nach Word ein, kopieren Sie ihn dort wieder und fügen Sie ihn dann im VBA - Editor ein
Gruß Hajo