نداء عاجل سؤال في المصفوفات

:mad: لغز صعب

لكن مع المحاولات أعتقد حيكون سهل

-ولو كان السئوال في منتدى فيجول بيسك أعتقد أفضل .

وشكراً

الأخ أبو عبدالملك

ليس لغزا وليس بالصعب على أهل هذا المنتدى

أما بالنسبة لرأيك بطرح السؤال بمنتدى فجول بيسك لقد عملت البرنامج بداية بـ vb ولكن حولته إلى access علما بأنه عمليات رياضيه والأفضل برمجتها كما تفضلت بـ vb ولكن من أجل الحصول على ملف حجمة صغير يمكن حملة على قرص مرن واحد

ويمكن تشغيلة على أغلب الأجهزة في المعمل بدون وجود مكتبة خاصة كما هو الحال بالنسبة لبرامج vb بل يكفي وجود access

شكرا لك ولرأيك وأملي لازال في محلة بك وبي جميع الأعضاء

هذا هو الكود المطلوب

و يسبقه شرحه

و تم إعداده ليناسب أي رقم و ليس 9 فقط

مع إمكانية عدم إستغلال أرقام مثلا يمكن

ترك أرقام و إختيار 1،5،10 مثلا

عن طريق إختيار حد أقصي 15 و

Step 5

:D:D:D:D:D:D

Global mymat(3, 3)  As Byte
Global resultsCounter As Integer
Global Validresults(100, 9) As Byte
Global ReqSum As Integer

Rem الي أعضاء المنتدي
Rem هذا الكود تم إعداده علي الإكسيل و هو صالح لباقي منتجات الأوفيس
Rem يقوم هذا الكود بالعثور علي  وحدات المصفوفة التي حجمها
Rem 3 X 3
Rem بحيث يكون المجموع للصفوف و الأعمدة يساوي رقم يحدده المستخدم
Rem يقوم هذا الكود بالبحث باستخدام خطوة بحثية يختارها المستخدم
Rem مثال خطوة = 5
Rem القيم التي يتم اختبارها هي 0،5،10،15
Rem بعد العثور علي الحل الأول يسأل البرنامج هل يكمل البحث أم لا
Rem يتم تخزين كل الحلول المتاحة فى مصفوفة تسمي Validresults
'=============================================================
' To the Arabteam 2000 Forum users
'This Code is prepared by VBA ( in Excel ) it is valid for
' VBA in Microsoft office products
'This code is made to find all the 3 x 3 Matrix Values
'That leads to a Sum of All Rows and Columns equal to a specific
'Value ( The User enters the requested Value in an input Promt)
'The Code also prompts for the searcg step
' Example by choosing step of 3 the coed uses the values of : 0,3,6,9
' as values of the Matrix
'To Find All Values or change the Step remove "Step 5" From
'the Nine Lines below
'After Finding the First Solution you Get a prompt Wether to Stop
'Searching or Not ??
'All the Valid results are Stored in a Matrix Named Valid results
'For Further Use
'=============================================================
'To Start the Program Activate the Sub Named Mat15
Rem للبدء في التشغيل شغل ال
Rem Sub : Mat15
'=============================================================
Sub Mat15()
ReqSum = InputBox("Please enter the required Sum Value" + Chr(10) + Chr(13) + "أدخل الرقم المطلوب أن يكون المجموع الأفقي  و الرأسي مساوياً له ", "Requested Sum", 15)
resultsCounter = 0
' To Search all integer values Remove the Step 5 from the nine lines below
Dim MyStep As Integer
Stepchoice:
MyStep = InputBox("Please enter the Search Step" + Chr(10) + Chr(13) + "أدخل خطوة البحث مثال   3 سيختبرالكود القيم بفرق 3 أي : 0،3،6،9... ", "Step of Search", 1)
If MyStep = 0 Or MyStep > ReqSum Then
 MsgBox "Invalid Selection of Step , Try again", vbCritical, "Invalid Step"
 GoTo Stepchoice
End If
  For i1 = 0 To ReqSum Step MyStep
  For i2 = 0 To ReqSum Step MyStep
  For i3 = 0 To ReqSum Step MyStep
  For i4 = 0 To ReqSum Step MyStep
  For i5 = 0 To ReqSum Step MyStep
  For i6 = 0 To ReqSum Step MyStep
  For i7 = 0 To ReqSum Step MyStep
  For i8 = 0 To ReqSum Step MyStep
  For i9 = 0 To ReqSum Step MyStep
    mymat(1, 1) = i1
    mymat(1, 2) = i2
    mymat(1, 3) = i3
    mymat(2, 1) = i4
    mymat(2, 2) = i5
    mymat(2, 3) = i6
    mymat(3, 1) = i7
    mymat(3, 2) = i8
    mymat(3, 3) = i9
      Dim mycheck As Boolean
      mycheck = checkit
      If mycheck = True Then
       Saveit
       Dim xx As String
       xx = PrintMasg
       x = MsgBox(xx, vbYesNo, "Found a solution !!")
       If x = vbNo Then Exit Sub
      End If
  Application.StatusBar = "Testing Value : " + Str(i1) + " " + Str(i2) + " " + Str(i3) + " " + _
  Str(i4) + " " + Str(i5) + " " + Str(i6) + " " + Str(i7) + " " + Str(i8) + " " + Str(i9) + "PLease Wait "
  Next i9
  Next i8
  Next i7
  Next i6
  Next i5
  Next i4
  Next i3
  Next i2
Next i1

 MsgBox Str(resultsCounter) + " Solutions Found ! ", vbInformation, "Search Results"
End Sub

Function checkit() As Boolean
Dim C1, C2, c3, R1, R2, R3 As Integer
 C1 = mymat(1, 1) + mymat(1, 2) + mymat(1, 3)
 C2 = mymat(2, 1) + mymat(2, 2) + mymat(2, 3)
 c3 = mymat(3, 1) + mymat(3, 2) + mymat(3, 3)
 R1 = mymat(1, 1) + mymat(2, 1) + mymat(3, 1)
 R2 = mymat(1, 2) + mymat(2, 2) + mymat(3, 2)
 R3 = mymat(1, 3) + mymat(2, 3) + mymat(3, 3)
If (C1 = ReqSum And C2 = ReqSum And c3 = ReqSum And R1 = ReqSum _
And R2 = ReqSum And R3 = ReqSum) Then
 checkit = True
Else
 checkit = False
End If
End Function

Sub Saveit()
       resultsCounter = resultsCounter + 1
       Validresults(resultsCounter, 1) = mymat(1, 1)
       Validresults(resultsCounter, 2) = mymat(1, 2)
       Validresults(resultsCounter, 3) = mymat(1, 3)
       Validresults(resultsCounter, 4) = mymat(2, 1)
       Validresults(resultsCounter, 5) = mymat(2, 2)
       Validresults(resultsCounter, 6) = mymat(2, 3)
       Validresults(resultsCounter, 7) = mymat(3, 1)
       Validresults(resultsCounter, 8) = mymat(3, 2)
       Validresults(resultsCounter, 9) = mymat(3, 3)
End Sub

Function PrintMasg() As String
    MsgTXT = "Found Solution no. : " & Str(resultsCounter)
    MsgTXT = MsgTXT + Chr(10) + Chr(13)
    MsgTXT = MsgTXT + Str(mymat(1, 1)) + "  " + Str(mymat(2, 1)) + "  " + Str(mymat(3, 1))
    MsgTXT = MsgTXT + Chr(10) + Chr(13)
    MsgTXT = MsgTXT + Str(mymat(1, 2)) + "  " + Str(mymat(2, 2)) + "  " + Str(mymat(3, 2))
    MsgTXT = MsgTXT + Chr(10) + Chr(13)
    MsgTXT = MsgTXT + Str(mymat(1, 3)) + "  " + Str(mymat(2, 3)) + "  " + Str(mymat(3, 3))
    MsgTXT = MsgTXT + Chr(10) + Chr(13)
    MsgTXT = MsgTXT + Chr(10) + Chr(13)
    MsgTXT = MsgTXT + " Do u want to Continue Searching ??"
  PrintMasg = MsgTXT
End Function

:rolleyes:

إن لم يكن ذلك فضولا

فأرجو إخباري عن البرنامج الذي تعده

:) :) :)

شكرا أخي مصراوي

البرنامج عبارة عن مجموع من القوانين الرياضية والفيزيائية

ومن بينها المربعات السحرية

استخدمت القانون التالي

b = a * (1 + a ^ 2) / 2

حيث (B)

هو مجموع الأرقام في أي عمود أو صف أو قطر

و (a)

هو العدد الذي يدخلة المستخدم

فمثلا لو أدخل المستخدم العدد (3)

سيكون الحاصل (15)

وهو مجموع الأرقام في أي عمود أو أي صف أو أي قطر

السؤال : كيف نوجد ما بداخل الجدول ( أي ما بداخل المربعات السحرية )

صراحة لم أجرب الكود الذي أرسلته

أتمنى لو ترفق لي ملف جاهز على الأكسس أو الأكسل مع شرح ولو بسيط لا أريد أن أثقل عليك

بارك الله فيك وبأمثالك من الناس الطيبين الخيرين

عزيزي مصراوي

لقد أختبرت الكود بواسطة VB

وبعد ظهور الرسائل

أدخل في الرسالة الأولى 15 والثانية اعداد مختلفة مره 3 ومره أخرى 4 وهكذا ولكن كان في كل مره يتوقف البرنامج عند

Application.StatusBar = "Testing Value : " + Str(i1) + " " + Str(i2) + " " + Str(i3) + " " + _

Str(i4) + " " + Str(i5) + " " + Str(i6) + " " + Str(i7) + " " + Str(i8) + " " + Str(i9) + "PLease Wait "

أرجو توضيح السبب إن أمكن

وتقبل خالص شكري وتقديري

تنويه

الكود مكتوب في البرنامج بشكل صحيح ليس كما هو في الاستفسار السابق ، تغير شكل السطر الأول

Application.StatusBar = "Testing Value : " + Str(i1) + " " + Str(i2) + " " + Str(i3) + " " + _

السلام عليكم و رحمة الله و بركاته

Application.Statusbar

هو يستدم فى الإكسيل لكي يتم من خلاله إظهار المرحلة التي يمر بها

البرنامح فى التنفيذ هنا أي يريك فى أسفل صفحة الإكسيل علي اليسار الأرقام الجاري إختبارها

و هو هنا غير مؤثر و يمكن حذفه إذا لم يتوافق مع الأكسيس

سأفوم بإرسال ملف الأكسيل اليك علي الميل

:cool: :cool: :cool:

العنوان البريدي الخاص بك غير ظاهر

أرجو إخباري به

حيث أن الرسائل الشخصية من خلال المنتدي لا يصحبها مرفقات

لقد أنشئت صفحة مجانية ووضعت بها الملف

و الرابط هو

ملف الأكسيل الذي به الكود - إضغط للتحميل

آمل أن يكون مفيدا

و عندما تنتهي أخبرني أكثر عن محتويات البرنامج و الغرض منه

;) ;) ;)

شكرا أخي مصراوي على أهتمامك بموضوعي

وأعدك إن شاء الله بإرسال نسخه من البرنامج لك مخصوص

سأجرب الملف الذي أرسلته وأحاول تطبيقة على vb و اكسس

أكرر شكري الخالص لك

السلام عليكم

أرجو ألا تتردد فى إخباري إن كان الكود غير واضح

و شكرا مقدما علي البرنامج !!!

:rolleyes: :rolleyes: :rolleyes: :rolleyes:

أخي مصراوي الكود واضح وشغال تمام

ولكن يأخذ وقتا لأختبار الأرقام وأعطاء النتيجة خاصة إذا كان مجموع الأعداد في كل صف أو عمود كبير ، وليس بالكبير جدا فمثلا الرقم 15 لا يعتبر كبير فإذا بدأ أختبار الأرقام من 1 يأخذ وقتا طويلا

قمت بتجريب أرقام صغير مثل 2 و 3 و 4

كما أن الكود يظهر أرقام مكرره داخل المصوفة وهذا غير مرغوب فيه في البرنامج الذي أعده

أنا أريد مصفوفه واحده يكون مجموع كل صف أو عمود الرقم المعطى دون تكرار أي عدد داخل المصفوفه

هل يمكن تعديل الكود ليلبي مطلبي

شكرا لتفاعلك وأهتمامك وأرجو المساعدة بكل ما تستطيع من قوه

السلام عليكم

الملف الموجود في هذه الوصلة به ثلاث حالات

الأولي مسموح بالتكرار

الثانية غير مسموح بالتكرار داخل نفس الصف أو العمود

الثالثة غير مسموح مطلقا ( نادرة الحدوث )

إضغط هنا

و السلام عليكم

هل فتحت الملف الجديد ؟

بالمناسبة أعتقد أنه يمكن تعديله أيضا لإختصار الوقت اذا لم يكن هذا مناسبا ، أرجو إخباري;)

كل عام وأنت وجميع المسلمين بألف خير بمناسبة حلول شهر رمضان المبارك أعادة الله علينا وعلى جميع المسلمين بألف خير

بارك الله فيك وبأمثالك أخي مصراوي

لقد فتحت الملف وكان ممتاز بالنسبة لما خصص له

ولكن بالنسبة لبرنامجي المشكلة تكمن في

1- المصفوفة غير ثابتة 3×3 كل مره

بل متغيره فإذا كانت 3×3 يجب أن يكون المجموع 15

وإذاكانت 4×4 يجب أن يكون المجموع 34

وإذا كانت 5×5 يكون المجموع 65

وفقا للمعادلة

b = a * (1 + a ^ 2) / 2

حيث (B)

هو مجموع الأرقام في أي عمود أو صف أو قطر

و (a)

هو العدد الذي يدخلة المستخدم لمثل عدد الصفوف والأعمده أي المصفوفه

فمثلا لو أدخل المستخدم العدد (3)

سيكون الحاصل (15)

أي مصفوفه 3×3 ومجموع كل صف أو عمود 15 بشرط عدم تكرار ما بداخل المصفوفه

يبدو أن العملية معقده ، ولكن متوقع أنك أهلا لها

لم ينقطع أملي في إيجاد الحل مادمت معي أخي بصراوي

السلام عليكم

هل المطلوب هو أن يكون حجم المصفوفة 3 أو 4 أو 5 تحديدا أم هذا مثال

الذي ذكرته مثال

حجم المصفوفه متغير

حسب الرقم الذي يدخله المستخدم بدلا من a في المعادلة المذكوره سابقا

ومجموع الأعمده والصفوف يكون مطابقا لناتج المعادلة

الا يمكن تحديد العدد

لأن عمل كود يحوي كل الإحتمالات أصعب بكثير جدا من أن يكون حجم المصفوفة محددا .

شكرا أخي مصراوي على كل ماقدمته لي من مساعدات وتوجيهات

سأكتفي بالمعادلة

وبما أرسلته لي من أكواد

وأتوقف عن أكمال البرنامج لأني مشغول في العمل صباحا

وأعطي دورة في الحاسب مساءا إلى منتصف الليل للمعلمين

فليس لدي وقت لفتح الأنترنت على الأقل

أكرر شكري الخالص لك - ولنا لقاء إن شاء الله - وأنا على وعدي لك بعد أكتمال البرنامج

السلام عليكم

أخي العزيز ، إذا أردت مساعدة حينما تحب إكمال برنامجك فأخبرني

و سأحاول إن شاء الله قدر استطاعتي

و بالتوفيق إن شاء الله

:rolleyes: :rolleyes: :rolleyes: