تاپيک: مسئله n وزیر
نمايش پست تنها
قديمي ۰۸-۲۲-۱۳۹۱, ۰۲:۳۲ قبل از ظهر   #2 (لینک دائم)
masood Male
عضو فوق فعال
 
آواتار masood
 
تاريخ عضويت: خرداد ۱۳۸۸
محل سكونت: اسالم
پست ها: 98
تشكرها: 291
37 تشكر در 30 پست
My Mood: Khoshhal
ارسال پيغام Yahoo به masood
Thumbs up

تقریبا یک سال از ارسال این سوال از طرف شما میگذره ولی من این موضوع رو تازه دیدم. (انقدر که تو انجمن فعالم)

خب اگه از بحث تعداد وزیر ها بخواهیم بگذریم کار خیلی سخت نیست. اول یه ماکرو در اکسل ایجاد می کنیم. بعد از طریق vba محتوای کد های داخل اون ماکرو رو با کد های زیر به طور کامل عوض می کنیم. بعد هم ماکرو رو اجرا می کنیم. فقط در مورد تعداد وزیر ها اینو بگم که ما یه تعدادی عدد هشت و نه تو برنامه داریم حالا اگه این تعداد رو تغییر بدیم اون وقت می تونیم تعداد وزیر ها رو بیشتر یا کمتر هم بکنیم. و باید به ازای اون تعداد تعداد ستون ها رو هم عوض کنیم. مثلا A:H رو به A:Q برای 17 تا وزیر تغییر بدیم. ماکرو بجای وزیر ها از علامت ستاره استفاده می کنه.
كد:
Sub Eight_Queens()
    Dim Conflict As Boolean
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    
    Dim x(1 To 8) As Integer
    For i = 1 To 8
        x(i) = 0
    Next
    
    i = 1
    While (i < 9)
        For j = x(i) + 1 To 8
            Conflict = False
            ' check for collision
            If i <> 1 Then
                ' horizental
                For k = 1 To i - 1
                    If x(k) = j Then
                        Conflict = True
                        Exit For
                    End If
                Next
                ' diagonal
                ' 1-up left
                i_copy = i
                j_copy = j
                Do While (i_copy > 1 And j_copy > 1 And Not Conflict)
                    i_copy = i_copy - 1
                    j_copy = j_copy - 1
                    If x(i_copy) = j_copy Then
                        Conflict = True
                    End If
                Loop
                
                ' 2-down left
                i_copy = i
                j_copy = j
                Do While (i_copy > 1 And j_copy < 9 And Not Conflict)
                    i_copy = i_copy - 1
                    j_copy = j_copy + 1
                    If x(i_copy) = j_copy Then
                        Conflict = True
                    End If
                Loop
            End If
            
            If Not Conflict Then
                x(i) = j
                Exit For
            End If
        Next
        If Conflict Then ' no position for current column then reset and return to previuse
            x(i) = 0
            i = i - 1
        Else ' if last queen set goto next queen
            i = i + 1
        End If
    Wend
    
    ' show resault
    For i = 1 To 8
        Range("A1").Select
        ActiveCell.Offset(x(i) - 1, i - 1).Select
        ActiveCell.FormulaR1C1 = "*"
    Next
    Columns("A:H").Select
    Columns("A:H").EntireColumn.AutoFit
    Rows("1:8").Select
    Rows("1:8").EntireRow.AutoFit
    Range("A1").Select
End Sub
__________________
یک روز یک ماشین برای انتخابات ریاست جمهوری ثبت نام می کند
چه بخواهیم چه نخواهیم این اتفاق می افتد.
masood آفلاين است   پاسخ با نقل قول