Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 00:42:03
Listbox mit gefilterten Daten füllen
24.04.2024 20:38:58
Summe mit Bedingung, nur letzte Ergebnisse anzeigen
24.04.2024 19:29:30
Formel filter
24.04.2024 18:49:56
merge & select
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1144to1148
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1144to1148
1144to1148
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Zugriff auf Daten

Zugriff auf Daten
alifa
Hallo Forum,
dieses Makro ermittelt die Kombinationen zur dritten Klasse ohne Wiederholung aus 6 Elementen.
Was muss geändert werden, damit nur die Kombinationen (Zeilen)geschrieben werden wo:
1. Die Zahl in Spalte A eine 2 als zweite Ziffer hat.
2. Die Zahl in Spalte B eine 5 als erste Ziffer hat.
3. Die Zahl in Spalte C eine 8 als letzte Ziffer hat.
Dieses ist das vereinfachte Beispiel eines komplizierteren Falles, ansonsten stellt sich die Sinnfrage.
Grüße, Erhard

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

Betreff
Benutzer
Anzeige
Sinnfrage: Welches Makro ? (owT)
23.03.2010 09:20:34
Renee

AW: Sinnfrage: Welches Makro ? (owT)
23.03.2010 10:18:50
alifa
hier!

Sub Gruppen()
Dim i&, u#, lngR&, n As Byte, k As Byte, j As Byte
Dim vSrc
vSrc = Array(123, 234, 345, 456, 567, 678) 'Einträge
k = 3
n = UBound(vSrc) + 1
With Application
u = .Fact(n) / (.Fact(k) * .Fact(n - k))
End With
ReDim vRes(k - 1)
ReDim bPos(k - 1) As Byte
For i = 1 To k
bPos(i - 1) = i
Next
With ActiveSheet
.Cells.Delete
For i = 1 To u
lngR = lngR + 1
For j = 0 To UBound(bPos)
vRes(j) = vSrc(bPos(j) - 1)
Next
.Range(.Cells(lngR, 1), .Cells(lngR, k)).Value = vRes
Call GetComb(n, k, bPos)
Next
End With
End Sub



Sub GetComb(ByVal n As Byte, ByVal k As Byte, bPos() As Byte)
Dim i As Byte, j As Byte
i = k - 1
Do While bPos(i) >= n - k + i + 1
If i = 0 Then Exit Do
i = i - 1
Loop
bPos(i) = bPos(i) + 1
For j = i To k - 1
bPos(j) = bPos(i) + j - i
Next
End Sub

Anzeige
Was ist das ?
23.03.2010 10:54:48
Renee
Hi Erhard,
Der Sinn dieses Codes u.v.a deiner Anfrage erschliesst sich mir in keiner Art und Weise.
Jedenfalls müsste für deine Anforderung dieser CodeTeil (für das Schreiben der Zellen) angepasst werden: 
       For i = 1 To u
For j = 0 To UBound(bPos)
vres(j) = vSrc(bPos(j) - 1)
Next
If Mid(vres(0), 2, 1) = 2 And _
Left(vres(1), 1) = 5 And _
Right(vres(2), 1) = 8 Then
lngR = lngR + 1
.Range(.Cells(lngR, 1), .Cells(lngR, k)).Value = vres
End If
Call GetComb(n, k, bPos)
Next

Es bleibt dann genau 1 Kombination übrig, welche deine Spezifikation erfüllt.
GreetZ Renée
Anzeige
AW: Was ist das ?
23.03.2010 14:53:50
alifa
Genau das habe ich nicht gewusst: Zugriff auf die Kombinationen. In das Datenfeld setze ich jetzt diese Zahlen ein:
125643 213465 312564 416325 516243 614523
134652 236145 325416 426153 521346 615342
145236 243516 342615 431256 523614 624351
153426 254163 346521 435162 534261 632541
162435 256431 351624 452361 541632 643125
163254 261534 361452 465213 564312 652134
und bilde sechser Kombinationen. (k=6) Wenn die Bedingungen erfüllt werden, wird wahrscheinlich nur eine Zeile bleiben. Wenn man die sechs Zahlen untereinander schreibt, entstehen 6 Zeilen und 6 Spalten.
Die Bedingung: die Spalten rauf und runter gelesen ergeben 12 sechsstellige Zahlen, die durch 7 teilbar sein sollen. Übrigens alle diese 36 Zahlen bestehen aus den Ziffern 1 bis 6 und sind vorwärts und rückwärts gelesen durch 7 teilbar. Alle Zahlen müssen verschieden sein. Wenn Dir eine schnelle Methode einfällt...Die Fleißarbeit habe ich selbst zu erledigen. Dir vielen Dank!!
Gruß, Erhard
Anzeige
Zu deiner Information,...
23.03.2010 21:21:31
Luc:-?
…Renée:
Erhard ist ein Fan alter Mathe-Knobel-Aufgaben, die er unter Zuhilfenahme von VBA zu lösen versucht. Mitunter weiß er schon, was rauskommen muss.
Gruß Luc :-?
Wo ist das Makro?
23.03.2010 09:28:13
welga
Hallo,
ich vermisse irgendwo das Makro!!!!!!
Ich würde es eventuell mal so versuchen (ungetestet):
a=false
for i=1 to thissheet.[a65536].End(xlUp).Row
If right(left(cells(i,1),2),1)=2 and left(cells(i,2),1)=5 and right(cells(i,3),1)=8 then a=true
if a then
rows(i).visible =true
else
rows(i).visible =false
end if
a=false
next i

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige