تقریبا یک سال از ارسال این سوال از طرف شما میگذره ولی من این موضوع رو تازه دیدم. (انقدر که تو انجمن فعالم
)
خب اگه از بحث تعداد وزیر ها بخواهیم بگذریم کار خیلی سخت نیست. اول یه ماکرو در اکسل ایجاد می کنیم. بعد از طریق 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