Excel: Array that involves a lot of calculations

[conceal]

Hello,

The last week I've been programming on a Excel-file that should calculate the optimal combination of persons and locations. I've made a table with 5 rows and 5 coloms. In the cells is a score filled in what gives an indication of the knowlegde of the person on that location (considering the activities he has to do there). I'm searching for the optimal combination, where each person has to have 1 location. To find this, I've made a calculation (zie VBA). For this small table it's simple to program, but I would like to extand this table to a 150 by 150 table (or even bigger). This means a lot of calculations and a lot of programming if I proceed this method. I'm searching for an array that ensures me that the loop isn't getting to big. Thanks for your effort!

The VBA code for the 5 by 5 table:

‘----------------------------------------------------------------------------------------
Private Sub CommandButton1_Click()
Dim rij%, rij1%, rij2%, rij3%, rij4%, rij5%, rijt%
Dim wp1%, wp2%, wp3%, wp4%, wp5%
Dim optie%, optie1%, optie2%

'I'm Dutch, so some variable's are in Dutch
'rij = row
'optie = option
'wp = werkplek = "location where someone works"

rij = 3
rij1 = 3
rij2 = 3
rij3 = 3
rij4 = 3
rij5 = 3
optie = 0
optie1 = 0
optie2 = 0


    While rij1 < 8
        While rij2 < 8
            If rij2 <> rij1 Then
            While rij3 < 8
                If rij3 <> rij1 Then
                If rij3 <> rij2 Then
                While rij4 < 8
                    If rij4 <> rij1 Then
                    If rij4 <> rij2 Then
                    If rij4 <> rij3 Then
                        While rij5 < 8
                        If rij5 <> rij1 Then
                        If rij5 <> rij2 Then
                        If rij5 <> rij3 Then
                        If rij5 <> rij4 Then
                        wp1 = Sheets("Sheet1").Cells(rij1, 2)
wp2 = Sheets("Sheet1").Cells(rij2, 3)
wp3 = Sheets("Sheet1").Cells(rij3, 4)
wp4 = Sheets("Sheet1").Cells(rij4, 5)
wp5 = Sheets("Sheet1").Cells(rij5, 6)
optie = wp1 * wp2 * wp3 * wp4 * wp5
optie1 = optie
                            If optie1 > optie2 Then
                            optie2 = optie1
                                Sheets("Sheet2").Select
                                Sheets("Sheet2").Range("A3:F15000").Delete
                                rij = 3
                                Sheets("Sheet2").Cells(rij, 1) = Sheets("Sheet1").Cells(rij1, 1)
                                Sheets("Sheet2").Cells(rij, 2) = Sheets("Sheet1").Cells(rij2, 1)
                                Sheets("Sheet2").Cells(rij, 3) = Sheets("Sheet1").Cells(rij3, 1)
                                Sheets("Sheet2").Cells(rij, 4) = Sheets("Sheet1").Cells(rij4, 1)
                                Sheets("Sheet2").Cells(rij, 5) = Sheets("Sheet1").Cells(rij5, 1)
                                Sheets("Sheet2").Cells(rij, 6) = optie2
                                Sheets("Sheet2").Cells(rij, 7) = wp1
                                Sheets("Sheet2").Cells(rij, 8) = wp2
                                Sheets("Sheet2").Cells(rij, 9) = wp3
                                Sheets("Sheet2").Cells(rij, 10) = wp4
                                Sheets("Sheet2").Cells(rij, 11) = wp5
                            Else
                                If optie1 = optie2 Then
                                        rij = rij + 1
                                        Sheets("Sheet2").Cells(rij, 1) = Sheets("Sheet1").Cells(rij1, 1)
                                        Sheets("Sheet2").Cells(rij, 2) = Sheets("Sheet1").Cells(rij2, 1)
                                        Sheets("Sheet2").Cells(rij, 3) = Sheets("Sheet1").Cells(rij3, 1)
                                        Sheets("Sheet2").Cells(rij, 4) = Sheets("Sheet1").Cells(rij4, 1)
                                        Sheets("Sheet2").Cells(rij, 5) = Sheets("Sheet1").Cells(rij5, 1)
                                        Sheets("Sheet2").Cells(rij, 6) = optie2
                                    End If
                            End If
                        End If
                        End If
                        End If
                        End If
                        rij5 = rij5 + 1
                        Wend
                        rij5 = 3
                    End If
                    End If
                    End If
                rij4 = rij4 + 1
                Wend
                rij4 = 3
                End If
                End If
            rij3 = rij3 + 1
            Wend
            rij3 = 3
            End If
        rij2 = rij2 + 1
        Wend
        rij2 = 3
    rij1 = rij1 + 1
    Wend

End Sub
‘--------------------------------------------------------------------------------------

The VBA-code I've now (but is not working) is:

'--------------
For i = 1 To 5
    While rij(i) < 8
        For j = 1 To i
            If rij(i) <> rij(j) Then
                        wp1 = Sheets("Sheet1").Cells(rij1, 2)
wp2 = Sheets("Sheet1").Cells(rij2, 3)
wp3 = Sheets("Sheet1").Cells(rij3, 4)
wp4 = Sheets("Sheet1").Cells(rij4, 5)
wp5 = Sheets("Sheet1").Cells(rij5, 6)
optie = wp1 * wp2 * wp3 * wp4 * wp5
optie1 = optie
                            If optie1 > optie2 Then
                            optie2 = optie1
                                Sheets("Sheet2").Select
                                Sheets("Sheet2").Range("A3:F15000").Delete
                                rij = 3
                                Sheets("Sheet2").Cells(rij, 1) = Sheets("Sheet1").Cells(rij1, 1)
                                Sheets("Sheet2").Cells(rij, 2) = Sheets("Sheet1").Cells(rij2, 1)
                                Sheets("Sheet2").Cells(rij, 3) = Sheets("Sheet1").Cells(rij3, 1)
                                Sheets("Sheet2").Cells(rij, 4) = Sheets("Sheet1").Cells(rij4, 1)
                                Sheets("Sheet2").Cells(rij, 5) = Sheets("Sheet1").Cells(rij5, 1)
                                Sheets("Sheet2").Cells(rij, 6) = optie2
                                Sheets("Sheet2").Cells(rij, 7) = wp1
                                Sheets("Sheet2").Cells(rij, 8) = wp2
                                Sheets("Sheet2").Cells(rij, 9) = wp3
                                Sheets("Sheet2").Cells(rij, 10) = wp4
                                Sheets("Sheet2").Cells(rij, 11) = wp5
                            Else
                                If optie1 = optie2 Then
                                        rij = rij + 1
                                        Sheets("Sheet2").Cells(rij, 1) = Sheets("Sheet1").Cells(rij1, 1)
                                        Sheets("Sheet2").Cells(rij, 2) = Sheets("Sheet1").Cells(rij2, 1)
                                        Sheets("Sheet2").Cells(rij, 3) = Sheets("Sheet1").Cells(rij3, 1)
                                        Sheets("Sheet2").Cells(rij, 4) = Sheets("Sheet1").Cells(rij4, 1)
                                        Sheets("Sheet2").Cells(rij, 5) = Sheets("Sheet1").Cells(rij5, 1)
                                        Sheets("Sheet2").Cells(rij, 6) = optie2
                                    End If
                            End If
            End If
        Next j
    Wend
Next i
'-----------------

 

[GlennUK]

You are searching for the best permutation of 5 from 5, which gives 120 results to pick from.

To generate all permutations of 150 from 150, would mean creating 5.7134 times 10 to power 262 permutations. If you only mean pemutations of 5 from 150, that's much smaller at 70992003600 permutations. Am I understanding you request correctly?

Cheers, Glenn.

Did you hear about the literalist show-jumper? He broke his nose jumping against the clock.

 

[conceal]

Hi Glenn,

Yes, I'm searching for the permutations of 150 from 150, which means that the number of calculations that need to be preformed by Excel is equal to the factorial of 150 = 5.7134 times 10 to power 262 calculations... and of all of these, I want to find the best possible...

Greetings,
Maik

 

[GlennUK]

If you managed 10 billion calculations per second, then your list of calculations would only take 1.8117 times 10 to power 245 years to complete. I'm not sure the Earth would still exist then.

Cheers, Glenn.

Did you hear about the literalist show-jumper? He broke his nose jumping against the clock.

 

[Welshbird]

I think the answer to this might be that Excel is not necessarily to right tool for the job.

Fee

The question should be [red]Is it worth trying to do?[/red] not [blue] Can it be done?[/blue]

 

[xlhelp]

How many generations of "conceal" would it require to analyze the data?

Please don't answer that.

Member- AAAA Association Against Acronym Abusers

 

[conceal]

Hello,

Well, I've found that the solution for this problem might be 'The Hungarian algorithm'. I'm still studying what this algorithm is and if it's programmable in VBA Excel. When I succeed, I will post the code if someone would like this.

Greetings,
Maik

 

[GlennUK]

Hi,

that would be great. Anything that can reduce the amount of calculations will be useful. I'd be very interested to see the code, thanks. Good luck.

Cheers, Glenn.

Did you hear about the literalist show-jumper? He broke his nose jumping against the clock.