AW: Das kann man übrigens auch noch so...
20.04.2010 09:19:20
Herbert
hallo luc,
ich blicke es einfach nicht. deshalb sende ich dir jetzt hier den originalcode, damit du dir ein bild davon machen kannst. dort wo "xxx" steht musste ich etwas verbergen. bitte habe verständnis dafür:
Option Private Module
Public gromPTBFF As Variant
Public Function Honorar(LB$, AK, HonZone, HonSatz, AusgWert%)
Dim wsAddIn As Worksheet, HzMin1$, HzMin2$, HzMax1$, HzMax2$
Dim ak_min, ak_max, HonMin0, HonMin1, HonMax0, HonMax1
Dim Höchstsatz, Mindestsatz, s§Spalte$, sLbPM2004$
Dim iMaxHz%, sAkSpalte$, iHzSpalte%, iLastRow%, sAkRegion$, objSheet As Object
On Error GoTo ende
Call ProdArgTausch("A1", HonSatz)
Set wsAddIn = ThisWorkbook.Sheets(LB)
With wsAddIn
Application.EnableEvents = False
iLastRow = .Cells(Rows.Count, HonZone).End(xlUp).Row
iMaxHz = .Range("1:1").Find(What:="ak").Column
sAkSpalte = Chr(iMaxHz + 64)
sAkRegion = sAkSpalte & "2:" & sAkSpalte & iLastRow
iHzSpalte = iMaxHz - 2
s§Spalte = Chr(iMaxHz + 65)
If LB = "PM-2004" And AK > 50000000 Then
iHzSpalte = 3
sLbPM2004 = " + AK > 50.000.000 "
End If
If HonZone = "5 +" Or HonZone = "5+" Or HonZone > "5" Or HonZone > iHzSpalte Then
HonZone = iHzSpalte
MsgBox "Die größte HonZone für """ & LB & sLbPM2004 & """ ist """ & iHzSpalte & """." _
& vbLf & vbLf & _
"Sie wird für die Berechnung automatisch angepasst!"
End If
HzMin1 = Chr(HonZone + 64)
HzMax1 = Chr(HonZone + 65)
If HonZone = 6 Then
HzMin2 = HzMax1
HzMax2 = HzMax1
Else
HzMin2 = Chr(HonZone + 65)
HzMax2 = Chr(HonZone + 66)
End If
ak_min = .Range(sAkSpalte & Application.Match(AK, .Range(sAkRegion), 1) + 1).Value
ak_max = .Range(sAkSpalte & Application.Match(AK, .Range(sAkRegion), 1) + 2).Value
HonMin0 = .Range(HzMin1 & Application.Match(AK, .Range(sAkRegion), 1) + 1).Value
HonMin1 = .Range(HzMin2 & Application.Match(AK, .Range(sAkRegion), 1) + 1).Value
HonMax0 = .Range(HzMin1 & Application.Match(AK, .Range(sAkRegion), 1) + 2).Value
HonMax1 = .Range(HzMin2 & Application.Match(AK, .Range(sAkRegion), 1) + 2).Value
Mindestsatz = xxx
HonMin0 = .Range(HzMax1 & Application.Match(AK, .Range(sAkRegion), 1) + 1).Value
HonMin1 = .Range(HzMax2 & Application.Match(AK, .Range(sAkRegion), 1) + 1).Value
HonMax0 = .Range(HzMax1 & Application.Match(AK, .Range(sAkRegion), 1) + 2).Value
HonMax1 = .Range(HzMax2 & Application.Match(AK, .Range(sAkRegion), 1) + 2).Value
Höchstsatz = xxx
End With
If HonSatz > 1 Then
HonSatz = 1
MsgBox "Der Honorarsatz darf 100% nicht übersteigen!" & vbLf & vbLf & _
"Die Berechnung wird automatisch angepasst!" & vbLf & vbLf & _
"Bitte ändern Sie Ihre Eingaben in der Zelle!"
End If
If HonSatz = 0 Then Honorar = Mindestsatz
If HonSatz = 1 Then Honorar = Höchstsatz
If HonSatz > 0 And HonSatz
Public Function ProdArgTausch(Bezug, Optional ByVal Faktor As Double = 100)
Const fakT As String = "163% 100%"
If Faktor = 1.63 Then gromPTBFF = Split(fakT, " ")
ProdArgTausch = Bezug * Faktor
End Function