Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
588to592
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
588to592
588to592
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

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
Anzeige
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

Anzeige
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
Anzeige
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
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige