Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

alle mögl. Zellenkombinationen mit Makro auflisten | Herbers Excel-Forum


Betrifft: alle mögl. Zellenkombinationen mit Makro auflisten von: Marie
Geschrieben am: 12.04.2012 11:30:11

Hallo zusammen!

Irgendwie stehe ich grad vor einem riesigen Problem. Ich benötige eine Art Tool, in dem verschiedene Daten eingetragen werden können und diese dann in allen möglichen Kombinationen ausgegeben werden.

Solche Daten sähen z.B. so aus (wobei die Anzahl der Daten und die Spaltenzahl variieren):

Spalte A
A
B
C
D

Spalte B
1
2
3
4
5
6

Spalte C
X


Nun soll in einem neuen Sheet folgendes dabei rauskommen (die Daten sollen durch Leerzeichen verbunden werden, damit der Post hier nicht zu lang wird habe ich nich alle Ergebnisse aufgelistet):

1 A X
2 A X
3 A X
4 B X
5 A X
6 A X
A 1 X
B X 1
C X 5
D 1 X
X D 5
.
.
.

Dazu habe ich folgendes Makro gefunden:

Sub Kreuztabelle_umsetzen()
'SheetNamen evt. anpassen
sn1 = "Tabelle1"
sn2 = "Tabelle2"
nzeile = 1
'letze Zeilen ermitteln
lZeileA = Sheets(sn1).Cells(65536, 1).End(xlUp).Row
lZeileB = Sheets(sn1).Cells(65536, 2).End(xlUp).Row
lZeileC = Sheets(sn1).Cells(65536, 3).End(xlUp).Row
lZeileD = Sheets(sn1).Cells(65536, 4).End(xlUp).Row
lZeileE = Sheets(sn1).Cells(65536, 5).End(xlUp).Row
' spalteninhalte löschen
Sheets(sn2).Columns(1).ClearContents
'NullSpalte abfangen
If lZeileA <= 2 Then lZeileA = 2
If lZeileB <= 2 Then lZeileB = 2
If lZeileC <= 2 Then lZeileC = 2
If lZeileD <= 2 Then lZeileD = 2
If lZeileE <= 2 Then lZeileE = 2
'umsetzen
For I5 = 2 To lZeileE
    For I4 = 2 To lZeileD
        For I3 = 2 To lZeileC
            For I2 = 2 To lZeileB
                For I1 = 2 To lZeileA
                    Sheets(sn2).Cells(nzeile, 1) = Sheets(sn1).Cells(I1, 1) & " " & _
                                                   Sheets(sn1).Cells(I2, 2) & " " & _
                                                   Sheets(sn1).Cells(I3, 3) & " " & _
                                                   Sheets(sn1).Cells(I4, 4) & " " & _
                                                   Sheets(sn1).Cells(I5, 5)
                    nzeile = nzeile + 1
                Next I1
            Next I2
        Next I3
    Next I4
Next I5
End Sub


Das funktioniert an sich super, nur gibt es mir nicht alle Daten, bzw. es vertauscht die Spalten nicht, um wirklich alle Möglichkeiten auszugeben. Es gibt mir nur die Reihenfolge "Spalte A Spalte B Spalte C".

Kann mir dabei vielleicht jemand helfen? VBA Kenntnisse sind leider kaum vorhanden...

Vielen Dank schonmal im Voraus & Beste Grüße,
Marie

  

Betrifft: AW: alle mögl. Zellenkombinationen mit Makro auflisten von: Dirk aus Dubai
Geschrieben am: 12.04.2012 13:21:27

Hallo!

Such mal nach 'Permutation'. Da sollte was zu finden sein.

Gruss

Dirk aus Dubai


  

Betrifft: Bei Kombinationen spielt die Reihenfolge der ... von: Luc:-?
Geschrieben am: 12.04.2012 13:30:03

…Elemente keine Rolle, Marie,
nur die Anzahl und ob mit oder ohne Wiederholung. Wenn die Reihenfolge für dich wichtig ist, handelt es sich um Variationen, die es auch mit oder ohne Wiederholung gibt. Das muss bekannt sein, bevor sich hier einer an der Lösung versucht. Außerdem will ich hoffen, dass das in der Realität nicht sehr viel mehr Elemente sind, sonst kann die Ergebnisermittlung sehr lange dauern.
Gruß Luc :-?


  

Betrifft: AW: alle mögl. Zellenkombinationen mit Makro auflisten von: CitizenX
Geschrieben am: 12.04.2012 14:55:05

Hi,

schau mal hier:

http://www.office-loesung.de/ftopic487566_0_0_asc.php&highlight=kombinationen

Grüße
Steffen


  

Betrifft: AW: alle mögl. Zellenkombinationen mit Makro auflisten von: Marie
Geschrieben am: 12.04.2012 15:57:06

Hallo,

danke für die schnellen Antworten.

@ Dirk: Bei der Suche nach Permutationen habe ich leider nichts gefunden, was mir behilflich sein könnte.

@ Luc: Danke für den Hinweis, dann handelt es sich um Variationen mit Wiederholung. Und es sind maximal 10 Begriffe in einer der Spalten, in einer anderen immer nur einer und in der dritten sind es ungefähr 4-6.

@ Steffen: Danke für den Link, ich hab das gleich mal mit Testdaten ausprobiert, nur leider ist das auch nicht die Lösung für meine Aufgabe. Ein Problem von diesem Makro ist u.A., dass wenn in einer Spalte weniger Werte sind als in den Anderen, diese nicht bei jeder Kombination berücksichtigt werden.


Nochmal ein kleines Beispiel, vielleicht kann ichs besser mit Worten beschreiben:
Ich habe gegeben:

Spalte 1: Katze

Spalte 2: rot

Spalte 3: hell


Das Ergebnis soll dann so aussehen:
hell Katze rot
hell rot Katze
Katze hell rot
Katze rot hell
rot hell Katze
rot Katze hell


Also dass jeder Begriff einmal den Platz getauscht hat mit den anderen.

Vielen Dank & Beste Grüße,
Marie


  

Betrifft: AW: alle mögl. Zellenkombinationen mit Makro auflisten von: Tino
Geschrieben am: 13.04.2012 10:06:29

Hallo,
kannst mal testen.

https://www.herber.de/bbs/user/79786.xls

Gruß Tino


  

Betrifft: AW: alle mögl. Zellenkombinationen mit Makro auflisten von: Marie
Geschrieben am: 13.04.2012 12:59:33

Hallo Tino,
Das alles kommt dem schon sehr sehr nahe :) danke dafür!
Genau so solls sein, nur dass man die Möglichkeit haben sollte, mehr als einen Begriff pro Spalte einzugeben. Und die Begriffanzahl ist in den Spalten verschieden. Ist sowas überhaupt umzusetzen per VBA?

Gruß,
Marie


  

Betrifft: AW: alle mögl. Zellenkombinationen mit Makro auflisten von: Rudi Maintaire
Geschrieben am: 13.04.2012 11:55:41

Hallo,
hab mal was zusammengebastelt.

Option Explicit
Const strDelim As String = "|"

Sub SpaltenKombinieren()
  Application.ScreenUpdating = False
  Dim objKombi As Object, rngC As Range, lngCount As Long
  Dim arrKombi(), arrTmp, i As Long, j As Long
  Dim colKombi As New Collection
  Set objKombi = CreateObject("Scripting.Dictionary")
  
  For Each rngC In Range("A:C").Columns
    colKombi.Add _
      Range(Cells(1, rngC.Column), Cells(Rows.Count, rngC.Column).End(xlUp)).Value
  Next
  
  Kombinieren_a colKombi, , objKombi
  
  If objKombi.Count > Rows.Count - 1 Then
    MsgBox "Zu viele Kombinationen (" & objKombi.Count & ")", , "Fehler"
  Else
    ReDim arrKombi(1 To objKombi.Count, 1 To colKombi.Count)
    For i = 1 To objKombi.Count
      arrTmp = Split(objKombi(i), strDelim)
      For j = 1 To colKombi.Count
        arrKombi(i, j) = arrTmp(j - 1)
      Next j
    Next i
    Workbooks.Add (1)
    Sheets(1).Cells(1, 1).Resize(UBound(arrKombi), UBound(arrKombi, 2)) = arrKombi
  End If
  
  Set objKombi = Nothing
  For lngCount = 1 To colKombi.Count
    colKombi.Remove 1
  Next
  Application.ScreenUpdating = True
End Sub

Sub Kombinieren_a(colKombi, Optional strAusgabe As String, Optional objKombi)
  Dim i As Long, arrValues, j As Integer
  Static lngStep As Long
  lngStep = lngStep + 1
  
  For i = 1 To UBound(colKombi(lngStep))
    If lngStep < colKombi.Count Then
        Kombinieren_a colKombi, strAusgabe & IIf(strAusgabe = "", "", strDelim) & colKombi( _
lngStep)(i, 1), objKombi
    Else
      arrValues = Split(strAusgabe & strDelim & colKombi(lngStep)(i, 1), strDelim)
      Kombinieren_b arrValues, "", objKombi
    End If
  Next i
  
  lngStep = lngStep - 1
End Sub

Sub Kombinieren_b(arrValues, strErg, objErg)
  Dim i%, j%, k%
  Dim strTmp, arrTmp
  If UBound(arrValues) > 0 Then
    ReDim arrTmp(UBound(arrValues) - 1)
    For i = 0 To UBound(arrValues)
      If strErg = "" Then
        strTmp = arrValues(i)
      Else
        strTmp = strErg & strDelim & arrValues(i)
      End If
      k = 0
      For j = 0 To UBound(arrValues) - 1
        If i = j Then k = 1
        arrTmp(j) = arrValues(j + k)
      Next j
      Kombinieren_b arrTmp, strTmp, objErg
    Next i
  Else
    objErg(objErg.Count + 1) = strErg & strDelim & arrValues(0)
  End If
End Sub

Gruß
Rudi


  

Betrifft: AW: alle mögl. Zellenkombinationen mit Makro auflisten von: Marie
Geschrieben am: 13.04.2012 12:58:28

Hallo Rudi,

Bei deinem Code kommt bei mir immer die Fehlermeldung: "Index außerhalb des gültigen Bereichs". Woran kann das liegen? Deswegen konnte ichs noch nicht testen... Danke für die Mühe!

Gruß,
Marie


  

Betrifft: wo kommt der Fehler? von: Rudi Maintaire
Geschrieben am: 13.04.2012 13:03:43

Hallo,
lad mal deine Mappe hoch.

Gruß
Rudi


  

Betrifft: AW: wo kommt der Fehler? von: Marie
Geschrieben am: 13.04.2012 13:09:05

https://www.herber.de/bbs/user/79787.xlsm

Jetzt kommmt "Typen unverträglich" :/ Wie gesagt, ich hab echt so gut wie keine Ahnung von VBA...

Gruß,
Marie


  

Betrifft: AW: wo kommt der Fehler? von: Rudi Maintaire
Geschrieben am: 13.04.2012 13:30:07

Hallo,
1. Der Code gehört in ein Modul.
2. Einen Einzeiler hatte ich nicht vorgesehen. Ist korrigiert.
Es muss in jeder Spalte 1 Begriff stehen.

Const strDelim As String = "|"

Sub SpaltenKombinieren()
  Application.ScreenUpdating = False
  Dim objKombi As Object, rngC As Range, lngCount As Long
  Dim arrKombi(), arrTmp, i As Long, j As Long
  Dim colKombi As New Collection
  Set objKombi = CreateObject("Scripting.Dictionary")
  
  For Each rngC In Range("A:C").Columns
    colKombi.Add _
      Range(Cells(1, rngC.Column), Cells(Rows.Count, rngC.Column).End(xlUp)).Value
  Next
  
  Kombinieren_a colKombi, , objKombi
  
  If objKombi.Count > Rows.Count - 1 Then
    MsgBox "Zu viele Kombinationen (" & objKombi.Count & ")", , "Fehler"
  Else
    ReDim arrKombi(1 To objKombi.Count, 1 To colKombi.Count)
    For i = 1 To objKombi.Count
      arrTmp = Split(objKombi(i), strDelim)
      For j = 1 To colKombi.Count
        arrKombi(i, j) = arrTmp(j - 1)
      Next j
    Next i
    Workbooks.Add (1)
    Sheets(1).Cells(1, 1).Resize(UBound(arrKombi), UBound(arrKombi, 2)) = arrKombi
  End If
  
  Set objKombi = Nothing
  For lngCount = 1 To colKombi.Count
    colKombi.Remove 1
  Next
  Application.ScreenUpdating = True
End Sub

Sub Kombinieren_a(colKombi, Optional strAusgabe As String, Optional objKombi)
  Dim i As Long, arrValues, j As Integer
  Static lngStep As Long
  lngStep = lngStep + 1
  If IsArray(colKombi(lngStep)) Then
  For i = 1 To UBound(colKombi(lngStep))
    If lngStep < colKombi.Count Then
        Kombinieren_a colKombi, strAusgabe & IIf(strAusgabe = "", "", strDelim) & colKombi( _
lngStep)(i, 1), objKombi
    Else
      arrValues = Split(strAusgabe & strDelim & colKombi(lngStep)(i, 1), strDelim)
      Kombinieren_b arrValues, "", objKombi
    End If
  Next i
  Else
    If lngStep < colKombi.Count Then
        Kombinieren_a colKombi, strAusgabe & IIf(strAusgabe = "", "", strDelim) & colKombi( _
lngStep), objKombi
    Else
      arrValues = Split(strAusgabe & strDelim & colKombi(lngStep), strDelim)
      Kombinieren_b arrValues, "", objKombi
    End If
  End If
  lngStep = lngStep - 1
End Sub

Sub Kombinieren_b(arrValues, strErg, objErg)
  Dim i%, j%, k%
  Dim strTmp, arrTmp
  If UBound(arrValues) > 0 Then
    ReDim arrTmp(UBound(arrValues) - 1)
    For i = 0 To UBound(arrValues)
      If strErg = "" Then
        strTmp = arrValues(i)
      Else
        strTmp = strErg & strDelim & arrValues(i)
      End If
      k = 0
      For j = 0 To UBound(arrValues) - 1
        If i = j Then k = 1
        arrTmp(j) = arrValues(j + k)
      Next j
      Kombinieren_b arrTmp, strTmp, objErg
    Next i
  Else
    objErg(objErg.Count + 1) = strErg & strDelim & arrValues(0)
  End If
End Sub

Gruß
Rudi


  

Betrifft: AW: wo kommt der Fehler? von: Marie
Geschrieben am: 13.04.2012 13:59:15

Danke Danke Danke

Du kannst dir garnicht vorstellen, wie sehr mir das hilft!
Genau so sollte es sein :)

Wenn ich jetzt noch eine Überschriftenzeile einbauen will, sodass das Kombinieren erst ab der 2. Zeile anfängt, welche Code-Zeilen müsste ich da ändern?

Gruß,
Marie


  

Betrifft: AW: wo kommt der Fehler? von: Rudi Maintaire
Geschrieben am: 13.04.2012 14:21:03

Hallo,
in Kombinieren_a

For i = 2 To UBound(colKombi(lngStep))
    If lngStep < colKombi.Count Then

Gruß
Rudi


  

Betrifft: AW: wo kommt der Fehler? von: Marie
Geschrieben am: 13.04.2012 14:36:35

Danke dir :)


Beiträge aus den Excel-Beispielen zum Thema "alle mögl. Zellenkombinationen mit Makro auflisten"