HERBERS Excel-Forum - die Beispiele

Thema: Auflistung aller Kombinationsmöglichkeiten

Home

Gruppe

Allgemein

Problem

100 Kugeln sind von 1 bis 100 beschriftet. 3 Kugeln werden gezogen. Alle Kombinationsmöglichkeiten werden aufgelistet.

Lösung
Den nachstehenden Code in ein Standardmodul eingeben, einer Schaltfläche zuweisen und starten.
StandardModule: Modul1

Sub CombiTest()
   Dim arr(1 To 100) As Integer
   Dim lAll As Long, lCount As Long
   Dim iCounter As Integer
   Dim iCol As Integer
   Dim iA As Integer, iB As Integer, iC As Integer
   Dim sTxt As String, sPath As String
   Dim bln As Boolean
   Application.ScreenUpdating = False
   bln = Application.DisplayStatusBar
   Application.DisplayStatusBar = True
   sPath = Application.DefaultFilePath & "\"
   lCount = WorksheetFunction.Combin(100, 3)
   For iCounter = 1 To 100
      arr(iCounter) = iCounter
   Next iCounter
   Close
   Open sPath & "\combin.txt" For Output As #1
   For iA = 1 To 98
      For iB = 2 To 99
         For iC = 3 To 100
            lAll = lAll + 1
            If lAll Mod 1000 = 0 Then Application.StatusBar = _
               "Bearbeite Kombination " & Format(lAll, "#,##0") & _
               " von " & Format(lCount, "#,##0") & "..."
            If iA >= iB Then iB = 1 + iA
            If iB >= iC Then iC = iB + 1
            If iCol < 3 Then
               iCol = iCol + 1
               sTxt = sTxt & arr(iA) & " " & arr(iB) & " " & arr(iC) & ","
            Else
               iCol = 1
               Print #1, Left(sTxt, Len(sTxt) - 1)
               sTxt = arr(iA) & " " & arr(iB) & " " & arr(iC) & ","
            End If
         Next
      Next
   Next
   Print #1, sTxt
   Close
   Application.StatusBar = "Lade die Daten..."
      Workbooks.OpenText Filename:=sPath & "combin.txt", _
      Origin:=xlWindows, _
      DataType:=xlDelimited, _
      ConsecutiveDelimiter:=False, _
      Tab:=False, _
      Semicolon:=False, _
      Comma:=True, _
      Space:=False, _
      Other:=False
   Application.StatusBar = False
   Application.DisplayStatusBar = bln
   Application.ScreenUpdating = True
End Sub

Beiträge aus dem Excel-Forum zu den Themen Allgemein und Liste

Wenn Feld leer, dann Auswahlliste EK Liste als eigene XLSX
verschiedene Maillisten je Auswahl aufrufen Todo-Liste sortieren
Namensliste 2 mit Formeln ableiten Anzeigename aus Outlook-Verteilerliste auslesen
Sonderzeichen auflisten Tabellenblätter nach Liste erstellen
Listen vergleichen Zelle färben wenn Wert in Liste vorkommt
e-Maladressen aus einer Liste daten lesen Doppelte Beiträge in Liste nur einmal auswählen
Zellen aus Liste in Spalten korrekt umsortieren Daten Auflisten
Gewicht in Speditionspreisliste finden Texte aus einer Liste sammeln
Abhängige Dropdown Listen mittels VBA Rangliste nach Altersklasse
Liste mit mehreren Einträgen ausfiltern Listenfeld in Userform Markierung aufheben
Doppelte anlisten Automatisch Liste erstellen
Datum in Listenfeld auswählen Liste (Gültigkeit,DropDown,etc) mehrere Kriterien
Auswahlliste AutoFilter-Auswahlliste per VBA auslesen
Liste automatisch neu erstellen und umsortieren Liste erstellen, aber wie ??
Top 10 Liste ausfiltern liste
Probleme mit Gültigkeitsliste Listen zusammenfassen - Daten verschwinden
Leerzeilen im Dropdown (Liste) - Menü Suche Makro: Zellenwert anh. Liste alle 15Sek.änd.
Anzeige eines Teilstrings in der Gültigkeitsliste Tabelle über Listenfeld füllen
Unterschiedliche Einträge herausfiltern+auflisten Verlassen von Auswahllisten
Eintrag in Liste finden Listen kombinieren, zusammenführen und erweitern
Werte aus Liste in x Blätter Nach Dateiumbenennung listet mein Zähler flasch
Daten von Listenfeld in Tabelle Auswahl aus Liste
VBA-Gesamtliste, gibt es so etwas? Frage an Renne,Diagramm mit mehrern Auswahllisten
Listenfeld laden, Mappe ohne speichern schliessen? Zwei Listen vergleichen
Stückliste Allgemeine Frage zur Fehlerbehandlung