VBA Excel: Permutation von geg. Werten

Computer: Software & Programmierung Visual Basic
1

Hallo,

ich habe eine Liste von Werten: 1000, 1001, 1002, …, 1999
Die Liste ist nicht fortlaufend.

Aus dieser Liste möchte ich nun folgende Matrix generieren:
Quasi alle möglichen (unterschiedlichen) Permutation:
A B

1000 1001
1000 1002
1000 …
1000 1999
1001 1000
1001 1002
1001 …
1001 1999
…
1999 1000
1999 1001
1999 1002
1999 …

Eigentlich sind das ja nur 2 for-schleifen ineinander geschachtelt und eine Abfrage, ob der Wert in Spalte A = dem Wert in Spalte B ist. DAnn muss diese Kombination übersprungen werden.

Für eine Hilfe wäre ich dankbar.

alex

2

Die Permutationsfunktion habe ich schon - auf ein anderes BSP gemünzt:

Sub permut()
Columns(„A:E“).ClearContents
a = Array(„A“, „B“, „C“, „D“)
Call permutation(a, 0)
End Sub
Function permutation(ByVal a, k)
If k = 3 Then
zeile = Cells(65536, 1).End(xlUp).Row
If Cells(1, 1) „“ Then zeile = zeile + 1
For i = 0 To 3
Cells(zeile, i + 1) = a(i)
Next
Else
For i = k To 3
x = a(i)
a(i) = a(k)
a(k) = x
Call permutation(a, k + 1)
Next
End If
End Function

Ich brauche das jetzt „nur“, dass die DAten aus der Excel Datei ausgelesen werden und dann z.B. in einem anderen Blatt ausgegeben werden.

[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]

3

ich habe eine Liste von Werten: 1000, 1001, 1002, …, 1999
Die Liste ist nicht fortlaufend.

Aus dieser Liste möchte ich nun folgende Matrix generieren:
Quasi alle möglichen (unterschiedlichen) Permutation:
A B

1000 1001
1000 1002

Hi Alex,
die Werte stehen im aktiven Tabellenblatt in A, das Ergebnis wird nach Tabelle2 A:B geschrieben:

Option Explicit

Sub tt()
Dim A As Long, B As Long, Zei As Long, Spa As Integer, Letzte As Long
Application.ScreenUpdating = False
On Error GoTo Fehler
Spa = 1
Letzte = Cells(Rows.Count, 1).End(xlUp).Row
For A = 1 To Letzte
 For B = 1 To Letzte
 If Cells(A, 1) Cells(B, 1) Then
 Zei = Zei + 1
 Worksheets("Tabelle2").Cells(Zei, Spa) = Cells(A, 1)
 Worksheets("Tabelle2").Cells(Zei, Spa + 1) = Cells(B, 1)
 End If
 Next B
 If Zei = Rows.Count Then
 Spa = Spa + 2
 Zei = 0
 End If
Next A
Fehler:
Application.ScreenUpdating = True
End Sub

Gruß
Reinhard

4

Hallo Reinhard,

vielen Dank. Hast mir sehr geholfen.

Alex