Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.07.2024 18:36:17
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

alle mögl. Zellenkombinationen mit Makro auflisten

alle mögl. Zellenkombinationen mit Makro auflisten
Marie
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 

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
AW: alle mögl. Zellenkombinationen mit Makro auflisten
12.04.2012 13:21:27
Dirk
Hallo!
Such mal nach 'Permutation'. Da sollte was zu finden sein.
Gruss
Dirk aus Dubai
Bei Kombinationen spielt die Reihenfolge der ...
12.04.2012 13:30:03
Luc:-?
…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 :-?
AW: alle mögl. Zellenkombinationen mit Makro auflisten
12.04.2012 15:57:06
Marie
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
Anzeige
AW: alle mögl. Zellenkombinationen mit Makro auflisten
13.04.2012 12:59:33
Marie
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
AW: alle mögl. Zellenkombinationen mit Makro auflisten
13.04.2012 11:55:41
Rudi
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  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
Anzeige
AW: alle mögl. Zellenkombinationen mit Makro auflisten
13.04.2012 12:58:28
Marie
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
wo kommt der Fehler?
13.04.2012 13:03:43
Rudi
Hallo,
lad mal deine Mappe hoch.
Gruß
Rudi
AW: wo kommt der Fehler?
13.04.2012 13:09:05
Marie
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
AW: wo kommt der Fehler?
13.04.2012 13:30:07
Rudi
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  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
Anzeige
AW: wo kommt der Fehler?
13.04.2012 13:59:15
Marie
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
AW: wo kommt der Fehler?
13.04.2012 14:21:03
Rudi
Hallo,
in Kombinieren_a
For i = 2 To UBound(colKombi(lngStep))
If lngStep 

Gruß
Rudi
AW: wo kommt der Fehler?
13.04.2012 14:36:35
Marie
Danke dir :)
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen
Forumthread
Beiträge