Gruppe
Allgemein
Problem
100 Kugeln sind von 1 bis 100 beschriftet. 3 Kugeln werden gezogen. Alle Kombinationsmöglichkeiten werden aufgelistet.
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