Gruppe
Funktion
Problem
Wie kann ich die Spielpaarungen eines Turniers von der Vorrunde bis zum Finale ermitteln? Je nach Festlegung des Siegers in einer Paarung sollen die Folgepaarungen angepaßt werden.
StandardModule: Modul1
Sub Bescheinigung()
Dim iRow As Integer
iRow = 2
With Worksheets("Adressen")
Do Until IsEmpty(.Cells(iRow, 1))
Range("A8:A11").ClearContents
Range("A8").Value = .Cells(iRow, 2).Value & " " & .Cells(iRow, 1).Value
Range("A9").Value = .Cells(iRow, 3).Value
Range("A11").Value = .Cells(iRow, 4).Value & " " & .Cells(iRow, 5).Value
Range("A28").Value = .Cells(iRow, 2).Value & " " & .Cells(iRow, 1).Value
Range("A29").Value = .Cells(iRow, 3).Value
Range("A30").Value = .Cells(iRow, 4).Value & " " & .Cells(iRow, 5).Value
Range("A36").Value = "XXX " & .Cells(iRow, 6).Value & " DM /" & _
ZahlWort(.Cells(iRow, 6).Value) & "/11.09.01 XXX"
iRow = iRow + 1
ActiveSheet.PrintPreview
Loop
End With
End Sub
StandardModule: Modul2
Function ZWort(dZahl As Double, Optional bln As Boolean)
Dim dRest As Double
dRest = WorksheetFunction.Round((dZahl - Fix(dZahl)), 2) * 100
dZahl = Fix(dZahl)
BisNeunzehn = Array("", "ein", "zwei", "drei", "vier", _
"fünf", "sechs", "sieben", "acht", "neun", "zehn", _
"elf", "zwölf", "dreizehn", "vierzehn", "fünfzehn", _
"sechzehn", "siebzehn", "achtzehn", "neunzehn")
Zehner = Array("", "zehn", "zwanzig", "dreißig", _
"vierzig", "fünfzig", "sechzig", "siebzig", _
"achtzig", "neunzig")
Tausender = Array("", "tausend", "millionen", "milliarden")
If dRest = 0 Then
ZWort = Text(dZahl)
Else
If bln Then
ZWort = Text(dZahl) & " " & dRest & "/00"
Else
ZWort = Text(dZahl)
End If
End If
End Function
Private Function Wort(wert As Integer) As String
Dim h As Integer
h = wert Mod 100
If h < 20 Then
Wort = BisNeunzehn(h)
Else
Wort = BisNeunzehn(h Mod 10) & IIf(h Mod 10 > 0, "und", "") & _
Zehner(Int(h / 10))
End If
h = (wert Mod 1000 - h) / 100
If h > 0 Then Wort = BisNeunzehn(h) & "hundert" & Wort
End Function
Private Function Text(wert As Double)
Dim l As Integer, i As Integer, p As Integer
If InStr(1, Str(wert), ",") = 0 And InStr(1, Str(wert), ".") = 0 Then
For i = 1 To 1 + Int(Len(Str(wert)) / 3)
p = Val("0" & Mid("000" + Str(wert), _
Len("000" & Str(wert)) - i * 3 + 1, 3))
If p > 0 Then Text = Wort(p) & Tausender(i - 1) & Text
Next
Else
Text = "#Ganzzahl!"
End If
If Right(Text, 3) = "ein" Then Text = Text & "s"
End Function