AW: Funktionen aktualisieren
09.11.2006 14:44:46
Markus
das steht im jeden sheet im worksheet_change ereignis
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo errExit
With Target
If .Validation.InCellDropdown Then 'prüft, ob Auswahlliste vorhanden ist
Select Case .Value
Case "Determ."
ActiveCell.Offset(0, 4).Value = "=" & ActiveCell.Offset(0, 1).Address
Case "Dreieck"
ActiveCell.Offset(0, 4).Value = "=Dreieck(" & ActiveCell.Offset(0, 1).Address & "," _
& ActiveCell.Offset(0, 2).Address & "," _
& ActiveCell.Offset(0, 3).Address & ")"
End Select
End If
End With
errExit:
End Sub
Dadurch wird die 4. Zelle neben dem DropDownListenfeld gefüllt.
Jetzt möchte ich das Tabellenblatt 1000 mal berechnen und bei jedem Durchgagn soll der Wert in der 4. Zelle sich ändern ,da ja ein RND im Code vorhanden ist.
Hier die Dreiecksfunktion
Function Dreieck(ByVal Mini As Double, ByVal Mittel As Double, ByVal Maxi As Double) As Double
Random = Rnd
If Random > 1 Or Random
If Mini >= Maxi Then Dreieck = CVErr(xlErrNA): Exit Function
If Mittel = Maxi Then Dreieck = CVErr(xlErrNA): Exit Function
If MCS = False Then
Dreieck = (Mini + Mittel + Maxi) / 3: Exit Function
End If
If Random
Dreieck = Mini + (((Maxi - Mini) * (Mittel - Mini) * Random) ^ (1 / 2))
Else
Dreieck = Maxi - ((((Maxi - Mini) * (Maxi - Mittel)) * (1 - Random)) ^ (1 / 2))
End If
End Function