Zahl bestimmen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo,

	A	B	C	D	E	F	G	H
1	Zahl	a	b	c	d	e	f	Test
2	100033	1	0	0	0	3	3	FALSCH
3	100034	1	0	0	0	3	4	FALSCH
4	100035	1	0	0	0	3	5	FALSCH
5	100036	1	0	0	0	3	6	FALSCH

Zelle	Formel
B2	=TEIL($A2;SPALTE(A1);1)
C2	=TEIL($A2;SPALTE(B1);1)
D2	=TEIL($A2;SPALTE(C1);1)
E2	=TEIL($A2;SPALTE(D1);1)
F2	=TEIL($A2;SPALTE(E1);1)
G2	=TEIL($A2;SPALTE(F1);1)
H2	{=UND(ZÄHLENWENN(B2:G2;" 3" )=2;SUMME(1/ZÄHLENWENN(B2:G2;B2:G2))=5)}
A3	=A2+1
B3	=TEIL($A3;SPALTE(A2);1)
C3	=TEIL($A3;SPALTE(B2);1)
D3	=TEIL($A3;SPALTE(C2);1)
E3	=TEIL($A3;SPALTE(D2);1)
F3	=TEIL($A3;SPALTE(E2);1)
G3	=TEIL($A3;SPALTE(F2);1)
H3	{=UND(ZÄHLENWENN(B3:G3;" 3" )=2;SUMME(1/ZÄHLENWENN(B3:G3;B3:G3))=5)}

Achtung, Matrixformel!

Die geschweiften Klammern{} nicht eingeben,

sondern die Zelle mit
Shift + Strg + Enter
verlassen statt Enter alleine.

Runter kopieren, bis der Excel-Arzt kommt und nach WAHR filtern.

	A	B	C	D	E	F	G	H
2303	102334	1	0	2	3	3	4	WAHR
2304	102335	1	0	2	3	3	5	WAHR
2305	102336	1	0	2	3	3	6	WAHR
2306	102337	1	0	2	3	3	7	WAHR
2307	102338	1	0	2	3	3	8	WAHR
2308	102339	1	0	2	3	3	9	WAHR
2312	102343	1	0	2	3	4	3	WAHR

Gruß
Rudi

Sub aaaa() Dim arrTmp(1 To 6), objZahl As Object, objTest As Object, a, b, c, d, e, f, i As Integer, n _ As Integer Set objTest = CreateObject("Scripting.dictionary") Set objZahl = CreateObject("Scripting.dictionary") For a = 1 To 9 For b = 1 To 9 For c = 1 To 9 For d = 1 To 9 For e = 1 To 9 For f = 1 To 9 arrTmp(1) = a arrTmp(2) = b arrTmp(3) = c arrTmp(4) = d arrTmp(5) = e arrTmp(6) = f n = 0 objTest.Removeall For i = 1 To 6 n = n - (arrTmp(i) = 3) Next If n = 2 Then For i = 1 To 6 objTest(arrTmp(i)) = 0 Next If objTest.Count = 5 Then objZahl(a & b & c & d & e & f) = 0 End If Next f Next e Next d Next c Next b Next a Sheets(1).Cells(1, 1).Resize(objZahl.Count) = WorksheetFunction.Transpose(objZahl.keys) End Sub

Hallo,


Sub Main()
Dim objArr As Object, arrKombi(0 To 5)
Dim i As Integer, j As Integer, k As Integer, l As Integer
Dim DasArray, arrTmp
Set objArr = CreateObject("Scripting.Dictionary")
arrKombi(4) = 3
arrKombi(5) = 3
arrTmp = Array(1, 2, 4, 5, 6, 7, 8, 9)
For i = 0 To UBound(arrTmp) - 3
arrKombi(0) = arrTmp(i)
For j = i + 1 To UBound(arrTmp) - 2
arrKombi(1) = arrTmp(j)
For k = j + 1 To UBound(arrTmp) - 1
arrKombi(2) = arrTmp(k)
For l = k + 1 To UBound(arrTmp)
arrKombi(3) = arrTmp(l)
Kombiniere "", arrKombi, objArr
Next
Next
Next
Next
DasArray = objArr.keys
'Ausgabe in neuem Blatt
Worksheets.Add.Cells(1, 1).Resize(UBound(DasArray) + 1) = WorksheetFunction.Transpose( _
DasArray)
End Sub


Sub Kombiniere(strTmp, DasArray, objArr As Object)
Dim i As Integer, j As Integer, k As Integer
Dim strTmp2, DasArray2
If UBound(DasArray) > 0 Then
ReDim DasArray2(UBound(DasArray) - 1)
For i = 0 To UBound(DasArray)
strTmp2 = strTmp & DasArray(i)
k = 0
For j = 0 To UBound(DasArray) - 1
If i = j Then k = 1
DasArray2(j) = DasArray(j + k)
Next j
Kombiniere strTmp2, DasArray2, objArr
Next i
Else
objArr(strTmp & DasArray(0)) = 0
End If
End Sub

Gruß ausm Pott
Udo

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread