Code

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
InputBox MsgBox
Bild

Betrifft: Code von: Andrea Schuler
Geschrieben am: 22.03.2005 09:34:07

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.

Bild


Betrifft: AW: Code von: bst
Geschrieben am: 22.03.2005 10:30:57

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



Bild


Betrifft: AW: Code von: Andrea Schuler
Geschrieben am: 22.03.2005 12:46:36

Vielen Dank, hat super funktioniert !


Bild


Betrifft: AW: Code von: ANdreas
Geschrieben am: 22.03.2005 12:17:01

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


Bild


Betrifft: AW: Code von: Andrea Schuler
Geschrieben am: 22.03.2005 12:47:19

Vielen Dank
VG
Andrea


Bild


Betrifft: Noch ne Möglichkeit von: UweD
Geschrieben am: 22.03.2005 16:37:21

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


 Bild

Beiträge aus den Excel-Beispielen zum Thema "leere Zeilen aussortieren"