Soru Minimum Maliyet Kodu

[saviola26]

Merhabalar,
Macar algoritması ile makinaların minimum maliyetini hesaplayan kod lazım. Daha önce bunun üzerine çalışmış olan üstad var mıdır? Çözücü ile yapılıyor. Ama VBA kodları ile nasıl yapılır acaba? Çözücü ile ilgili yapılan videosunu da ekliyorum. Aynı işlemi VBA kodu ile nasıl yapacağımı bilemedim. Teşekkür ederim.

 

[ÖmerFaruk]

İstediğiniz Videoda anlatınlan konunun birebir makro ile çözümü mü?
Eğer farklı ise lütfen şimdiden belirtin.

 

[saviola26]

İstediğiniz Videoda anlatınlan konunun birebir makro ile çözümü mü?
Eğer farklı ise lütfen şimdiden belirtin.

Çözüm aynı sadece tablo 5*5 lik bir tablo. VBA kodları ile çözülecek. İlginiz için teşekkürler.

 

[ÖmerFaruk]

Ekran görüntüsü

Kullandığım kod.

Sub MinimumBul()
    Dim Veri, Liste(), Minimum As Integer
    Veri = Range("B2:F6").Value
    Minimum = 32767
    For x1 = 1 To 5
        For x2 = 1 To 5
            If x1 <> x2 Then
                For x3 = 1 To 5
                    If x1 <> x3 And x2 <> x3 Then
                        For x4 = 1 To 5
                            If x1 <> x4 And x2 <> x4 And x3 <> x4 Then
                                For x5 = 1 To 5
                                    If x1 <> x5 And x2 <> x5 And x3 <> x5 And x4 <> x5 Then
                                        Toplam = Veri(1, x1) + Veri(2, x2) + Veri(3, x3) + Veri(4, x4) + Veri(5, x5)
                                        If Toplam <= Minimum Then
                                            Minimum = Toplam
                                            ReDim Liste(1 To 5, 1 To 5)
                                            Liste(1, x1) = 1
                                            Liste(2, x2) = 1
                                            Liste(3, x3) = 1
                                            Liste(4, x4) = 1
                                            Liste(5, x5) = 1
                                        End If
                                    End If
                                Next x5
                            End If
                        Next x4
                    End If
                Next x3
            End If
        Next x2
    Next x1
    Range("B9").Resize(5, 5) = Liste
    End Sub

Dosyanız ekte ve altın üye olmadığınız için aşağıdaki harici linkte.
Bu linki tıklayıp indirebilirsiniz.

 

[saviola26]

Ekran görüntüsü
Ekli dosyayı görüntüle 233156
Kullandığım kod.

Sub MinimumBul()
    Dim Veri, Liste(), Minimum As Integer
    Veri = Range("B2:F6").Value
    Minimum = 32767
    For x1 = 1 To 5
        For x2 = 1 To 5
            If x1 <> x2 Then
                For x3 = 1 To 5
                    If x1 <> x3 And x2 <> x3 Then
                        For x4 = 1 To 5
                            If x1 <> x4 And x2 <> x4 And x3 <> x4 Then
                                For x5 = 1 To 5
                                    If x1 <> x5 And x2 <> x5 And x3 <> x5 And x4 <> x5 Then
                                        Toplam = Veri(1, x1) + Veri(2, x2) + Veri(3, x3) + Veri(4, x4) + Veri(5, x5)
                                        If Toplam <= Minimum Then
                                            Minimum = Toplam
                                            ReDim Liste(1 To 5, 1 To 5)
                                            Liste(1, x1) = 1
                                            Liste(2, x2) = 1
                                            Liste(3, x3) = 1
                                            Liste(4, x4) = 1
                                            Liste(5, x5) = 1
                                        End If
                                    End If
                                Next x5
                            End If
                        Next x4
                    End If
                Next x3
            End If
        Next x2
    Next x1
    Range("B9").Resize(5, 5) = Liste
    End Sub

Dosyanız ekte ve altın üye olmadığınız için aşağıdaki harici linkte.
Bu linki tıklayıp indirebilirsiniz.

Çok teşekkür ederim. Elinize sağlık