13. maj 2020 - 12:30Der er
21 kommentarer og 4 løsninger
9 stole, 9 personer ?
Der er 9 stole og 9 personer. Kan personerne sidde på 9! (9 fakultet) forskellige måder ? Hvordan kan jeg vise alle mulighederne i Excel eller VBA ? Tak finb
Min pointe var, at hvis det er et rundt bord (re #2), så er placeringen af den første person ligegyldig og dermed er svaret 8! i stedet for 9! hvor ! læses som fakultet.
Og hvis rækkefælgen er ligegyldig, så kan 9 personer kun placeres i 9 stole på én måde, nemlig en i hver stol.
min idé var, at fx "abcdefghi" er ok - men alle skift til "bcdefghia" osv "defghiabc" med mere udgår, så for hver 1 godkendt række er der 8, der udgår - så noget med 9!/9
Og her er en makro, som viser alle kombinationsmulighederne, men lad være med at køre den, hvis du skal bruge Excel til noget andet den næste times tid.
Sub fact() Application.Calculation = xlCalculationManual Dim A, B, C, D, E, F, G, H, I, R, X As Long R = 1 For X = 123456789 To 987654321 A = Mid(X, 1, 1) If A = 0 Then X = X + 100000000 B = Mid(X, 2, 1) If B = 0 Then X = X + 10000000 C = Mid(X, 3, 1) If C = 0 Then X = X + 1000000 D = Mid(X, 4, 1) If D = 0 Then X = X + 100000 E = Mid(X, 5, 1) If E = 0 Then X = X + 10000 F = Mid(X, 6, 1) If F = 0 Then X = X + 1000 G = Mid(X, 7, 1) If G = 0 Then X = X + 100 H = Mid(X, 8, 1) If H = 0 Then X = X + 10 I = Mid(X, 9, 1) If I = 0 Then X = X + 1 If A <> B And A <> C And A <> D And A <> E And A <> F And A <> G And A <> H And A <> _ I And B <> C And B <> D And B <> E And B <> F And B <> G And B <> H And B <> _ I And C <> D And C <> E And C <> F And C <> G And C <> H And C <> _ I And D <> E And D <> F And D <> G And D <> H And D <> _ I And E <> F And E <> G And E <> H And E <> _ I And F <> G And F <> H And F <> _ I And G <> H And G <> I And H <> _ I And A <> 0 And B <> 0 And C <> 0 And D <> 0 And E <> 0 And F <> 0 And G <> 0 And H <> 0 And I <> 0 Then Cells(R, 1) = X R = R + 1 End If Next Application.Calculation = xlCalculationAutomatic End Sub
Ved at lede på en gammel pc fandt jeg noget kode lavet af Excel MVP Myrna Larson tilbage i år 2000 og posteret i Microsoft.Public.Excel.Misc. Koden er lavet mens Excel kun havde 65536 rækker.
Koden genererer en liste med FACT(8) = 40320 i løbet af et splitsekund og en liste med FACT(9) = 362880 på mindre end fem sekunder. Listen indsættes i et nyt ark. Filen er gemt som Excel 97-2003 workbook. Lav ikke om på det.
Ups. Makroen i #12 springer nogle (ca. 40.000) kombinationer over. Men denne finder alle 362800.
Sub fact() Application.Calculation = xlCalculationManual Dim A, B, C, D, E, F, G, H, I, R, X As Long R = 1 For X = 123456789 To 987654321 A = Left(X, 1) B = Mid(X, 2, 1) C = Mid(X, 3, 1) D = Mid(X, 4, 1) E = Mid(X, 5, 1) F = Mid(X, 6, 1) G = Mid(X, 7, 1) H = Mid(X, 8, 1) I = Mid(X, 9, 1) If A <> B And A <> C And A <> D And A <> E And A <> F And A <> G And A <> H And A <> _ I And B <> C And B <> D And B <> E And B <> F And B <> G And B <> H And B <> _ I And C <> D And C <> E And C <> F And C <> G And C <> H And C <> _ I And D <> E And D <> F And D <> G And D <> H And D <> _ I And E <> F And E <> G And E <> H And E <> _ I And F <> G And F <> H And F <> _ I And G <> H And G <> I And H <> _ I And B <> 0 And C <> 0 And D <> 0 And E <> 0 And F <> 0 And G <> 0 And H <> 0 And I <> 0 Then Cells(R, 1) = X R = R + 1 End If Next Application.Calculation = xlCalculationAutomatic End Sub
Lige et tillægsspørgsmål: Nu stiger komforten, og stol 1, stol 2 og stol 3 deler bord 1 stol 4, stol 5 og stol 6 deler bord 2 stol 7, stol 8 og stol 6 deler bord 3
Hvis der ved fx bord 1 sidder person 1,2,3 så kan der ikke også sidde person 2,1,3 eller person 3,1,2 osv. ved bord 1.
Bord 1 må altså kun tildeles 1 konstellation af personerne 1,2,3. Ligeså med bord 2 og 3. Det giver selvfølgelig færre løsninger, hvordan kan det programmeres i VBA ? Tak finb (bordene er ikke runde, ha ha)
Du får lige makroen til det. Ikke særlig elegant, men det var den eneste måde jeg kunne få det til at fungere på. Jeg laver ligesom ved den foregående alle muligheder (362880 kombinationer), men deler det op i tre kolonner, og sletter så alle dem der har de samme tal i kolonne C. Så ryger 5 af 6 ud. Så sorteres og så slettes alle der har de samme tal i kolonne B. Igen ryger 5 af 6. Til sidst det samme med kolonne A. Igen ryger 5 af 6. Den tog et par timer at køre, men kom som forventet ud med 1680 kombinationer. 1680 =(9!/6!/3!)*(6!/3!/3!)=9!/6/6/6
Sub fact() Application.Calculation = xlCalculationManual Dim A, B, C, D, E, F, G, H, I, R, X As Long R = 1 For X = 123456789 To 987654321 A = Left(X, 1) B = Mid(X, 2, 1) C = Mid(X, 3, 1) D = Mid(X, 4, 1) E = Mid(X, 5, 1) F = Mid(X, 6, 1) G = Mid(X, 7, 1) H = Mid(X, 8, 1) I = Mid(X, 9, 1) If A <> B And A <> C And A <> D And A <> E And A <> F And A <> G And A <> H And A <> _ I And B <> C And B <> D And B <> E And B <> F And B <> G And B <> H And B <> _ I And C <> D And C <> E And C <> F And C <> G And C <> H And C <> _ I And D <> E And D <> F And D <> G And D <> H And D <> _ I And E <> F And E <> G And E <> H And E <> _ I And F <> G And F <> H And F <> _ I And G <> H And G <> I And H <> _ I And B <> 0 And C <> 0 And D <> 0 And E <> 0 And F <> 0 And G <> 0 And H <> 0 And I <> 0 Then Cells(R, 1) = A & B & C Cells(R, 2) = D & E & F Cells(R, 3) = G & H & I
R = R + 1 End If Next 'Sletter alle rækker med de samme tal i kolonne C For R = 362880 To 2 Step -1 If Cells(R, 1) = Cells(R - 1, 1) And Cells(R, 2) = Cells(R - 1, 2) Then Rows(R).EntireRow.Delete End If
Next 'Ny sortering Range("A1:C1").Select Range(Selection, Selection.End(xlDown)).Select ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range( _ "A1:A60480"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range( _ "C1:C60480"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range( _ "B1:B60480"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal With ActiveWorkbook.Worksheets("Sheet1").Sort .SetRange Range("A1:C60480") .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 'Sletter alle rækker med de samme tal i kolonne B For R = 60480 To 2 Step -1 If Cells(R, 1) = Cells(R - 1, 1) And Cells(R, 3) = Cells(R - 1, 3) Then Rows(R).EntireRow.Delete End If Next 'Ny sortering Range("A1:C1").Select Range(Selection, Selection.End(xlDown)).Select ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range( _ "B1:B10080"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range( _ "C1:C10080"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range( _ "A1:A10080"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal With ActiveWorkbook.Worksheets("Sheet1").Sort .SetRange Range("A1:C10080") .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 'Sletter all rækker med de samme til i kolonne A For R = 10080 To 2 Step -1 If Cells(R, 2) = Cells(R - 1, 2) And Cells(R, 3) = Cells(R - 1, 3) Then Rows(R).EntireRow.Delete End If Next 'Ny sortering (tilbage til det oprindelige) Range("A1:C1").Select Range(Selection, Selection.End(xlDown)).Select ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range( _ "A1:A1680"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range( _ "B1:B1680"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range( _ "C1:C1680"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal With ActiveWorkbook.Worksheets("Sheet1").Sort .SetRange Range("A1:C1680") .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With
Application.Calculation = xlCalculationAutomatic End Sub
Du tager først 3 af 9. Der er der 9!/6!/3! muligheder. Derefter tages der 3 af 6. Der giver 6!/3!/3! muligheder. Og de sidste 3 kommer i sidste gruppe. Det giver 1 mulighed. Ialt (9!/6!/3!)*(6!/3!/3!)*1
Men hov, er det nu rigtigt ? Den nedenstående ændrer 123,123,123 til: 123 -men ændrer den fx 123,231,321 til: 123 ?
""'Sletter alle rækker med de samme tal i kolonne B For R = 60480 To 2 Step -1 If Cells(R, 1) = Cells(R - 1, 1) And Cells(R, 3) = Cells(R - 1, 3) Then Rows(R).EntireRow.Delete End If Next""
Nej, den ændrer ikke rækkefølgen i cellen til 123, den sletter alle rækker nedenunder den række, hvor der står 123. Det er betinget af den foregående sortering, således at cellen med 123 altid står øverst
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.