HERBERS Excel-Forum - die Beispiele

Thema: Spielpaarungen von Vorrunde bis Finale durch Formeln ermitteln

Home

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.

Lösung
Nur anhand einer Beipspielarbeitsmappe darstellbar.
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

Beiträge aus dem Excel-Forum zu den Themen Funktion und WENN

Copy funktioniert nur einmal Schreibschutz prüfen funktioniert nicht
Wenn Feld leer, dann Auswahlliste VBA - Wochentage, zählenwenn
Split-Funktion beim Einlesen TXT-Datei Match Funktion spinnt (?)
Bed. Formatierung, wenn alle Beding. erfüllt. summewenn verbessern
IF / WENN / Englisch / Deutsch Windows SVerweis funktioniert nicht
PasteSpecial funktioniert nicht. Formel wenn Wert gefunden überschreiben
MITTELWERTWENN ohne die aktuelle Zeile WENN WAHR dann Wert
Zelle färben wenn Wert in Liste vorkommt Zellen auslesen,wenn im Blattnamen 2019
Zählenwenn Formel ODER/WENN
Objektvariable nicht definierte (wenn...) Löschen Zeilen wenn zwei Bedinungen nicht vorhande
VBA-Code funktioniert nicht mit anderem Office Hilfe bei der INDEX Funktion
Wenn Formel SVERWEIS mit Zählenwenn
MAX wenn mit Indirekt in Matrixformel wenn . in Zelle darf kein OK geschrieben sein
Zelladressen von FunktionsParametern ermitteln Nach erfolgter Eingabe Makro nicht ausführen wenn
Wenn Dann nicht ausfüllen Zellen sperren wenn Bedingung in anderer Zelle erf
Matrixformel mit Summenfunktion SUMMEWENN über mehrere
Formel funktioniert nicht, SVerweis Summewenn mit Bezug auf ein Datum
Zellen einfärben wenn Bedingung erfüllt Wenn alle Zellen unter einer Zelle leer sind, dann
wenn-dann mit 2 Bedingungen aus Spalte/Zeile Makro funktioniert nach Beenden von Excel nicht
Nochmal WENN mit mehreren Bedingungen VLOOKUP auf Links funktioniert offline
SUM in erste leere Zeile von Oben WENN @DAVID Zwei SUMMEWENN funktionen verknüpfen
Zählen wenn als VBA Zwei SUMMEWENN funktionen verknüpfen
Polynomfunktion Summe bilden wenn zwei Kriterien übereinstimmen
Summewenn mit meheren Kriterien/Blaettern Mit vba Funktionen in Excel Zellen
Abfrage mit WENN Wenn 3, dann eins dazu