Code

Forumthread: Code

Code

22.03.2005 09:34:07

Andrea

Ich habe folgendes Problem: habe einen 10 ziffrigen Code der in 10 horizontal aufeinanderfolgenden Zellen steht. Jede Zelle kann hierbei die Werte 0,1 oder 2 enthalten. Ich suche nach einer Möglichkeit, wie ich alle Codekombinationen mittels Excel darstellen kann. Die max. Anzahl der Codekombinationen beträgt 3^10 ( =59049). Im voraus Vielen Dank für eine event. Lösung.

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Code

22.03.2005 10:30:57

bst
AW: Code

22.03.2005 12:46:36

Andrea
AW: Code

22.03.2005 12:17:01

ANdreas
AW: Code

22.03.2005 12:47:19

Andrea
Noch ne Möglichkeit

22.03.2005 16:37:21

UweD

AW: Code

22.03.2005 10:30:57

bst

Morgen Andrea,
versuch mal sowas.
HTH, Bernd
--
Option Explicit


Sub Variationen()
Call doVar(10, 2)
End Sub


Sub doVar(maxSpalte As Integer, maxWert As Integer)
Dim i As Integer, zeile As Long
For i = 1 To maxSpalte - 1: Cells(1, i).Value = 0: Next i
Cells(1, maxSpalte) = -1
zeile = 1
While Inc(zeile, maxSpalte, maxWert)
If zeile Mod 100 = 0 Then Application.StatusBar = "Zeile: " & zeile
Range(Cells(zeile, 1), Cells(zeile, maxSpalte)).Copy Cells(zeile + 1, 1)
zeile = zeile + 1
Wend
Range(Cells(zeile, 1), Cells(zeile, maxSpalte)) = ""
Application.StatusBar = False
End Sub


Function Inc(zeile As Long, spalte As Integer, max As Integer) As Boolean
Inc = True
If Cells(zeile, spalte) < max Then
Cells(zeile, spalte) = Cells(zeile, spalte) + 1
ElseIf spalte > 1 Then
Cells(zeile, spalte) = 0
Inc = Inc(zeile, spalte - 1, max)
Else
Inc = False
End If
End Function

AW: Code

22.03.2005 12:46:36

Andrea

Vielen Dank, hat super funktioniert !

AW: Code

22.03.2005 12:17:01

ANdreas

Hallo Andrea,
noch eine andere Möglichkeit:


Private Function Umwandlung(ByVal lngParam&, intParam%) As String
Dim i&, s$
' Diese Funktion wandelt Dezimalzahlen in Zahlen mit Potenz <= 10 um
Do
i = lngParam \ intParam
s = (lngParam Mod intParam) & s
lngParam = i
Loop Until i = 0
Umwandlung = s
End Function

Sub ErmittleCodes()
Dim i%, intAnzahlStellen%, n%
Dim j&, sFormat$, lngAnzahl&
i = 3 ' 3er Potenzen
intAnzahlStellen = 10
For j = 1 To intAnzahlStellen
sFormat = sFormat & "0 " ' Format: mit 0 auffüllen + Trennzeichen)
Next j
lngAnzahl = i ^ intAnzahlStellen
If lngAnzahl > Rows.Count Then
MsgBox "Zeilen von Excel nicht ausreichend"
Exit Sub
End If
' Hochzaehlen von 0 bis Anzahl Variationen
For j = 0 To lngAnzahl - 1
' Dezimalzahl umwandeln +
' ganze Variation in Zelle schreiben (spart Schreiboperationen)
Cells(j + 1, 1).Value = Format(Umwandlung(j, i), sFormat)
' Fortschritt anzeigen
If j Mod 100 = 99 Then Application.StatusBar = "Kombination " & j + 1 _
& " (" & Format((j + 1) / lngAnzahl, "0.0%") & ")"
Next j
' Variationen auf einzelne Spalten aufteilen (Leerzeichen Trennzeichen)
Columns(1).TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Space:=True
Application.StatusBar = False
End Sub
Gruß
Andreas

AW: Code

22.03.2005 12:47:19

Andrea

Vielen Dank
VG
Andrea

Noch ne Möglichkeit

22.03.2005 16:37:21

UweD

Hallo
Hier noch eine Möglichkeit

Option Explicit
Sub Perm()
    Dim n%, Va(), k%, AnZ#, Z#, S%, H%, I%
    n = InputBox("n ?", "Anzahl Spalten", 10)
    k = InputBox("k ?", "Anzahl Werte", 3)
    Range(Columns(1), Columns(n)).Clear 'Bereich leeren
    ReDim Va(k)
    For I = 1 To k
        Va(I) = InputBox("Wert k" & I & " eingeben")
    Next
    AnZ = k ^ n 'Anzahl mögliche Kombinationen
    Application.ScreenUpdating = False
    For S = 1 To n 'Anzahl Spalten
    Z = 1
        Do
            For I = 1 To k
                For H = 1 To 3 ^ (S - 1) 'Anzahl Wiederholungen
                    Cells(Z, S) = Va(I)
                    Z = Z + 1
                Next H
            Next I
        Loop Until Z >= AnZ
        'Fortschrittsanzeige
        Application.StatusBar = "Bitte warten " & _
            Format(S / n, "0%") & " fertig"
    Next
    Application.ScreenUpdating = True
    Application.StatusBar = False
End Sub

Gruß UweD

Beliebteste Forumthreads (12 Monate)

Forumthread: Code

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread