اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

اخي العزيز شكرا للاهتمام

تصل للنتيجة العلوية من المربعات D6 + C2 + Z حيث ان عمودات الارقام من مربع العلوي هي من مربع السفلى D6 مثلا عمود 1,7,13,19,25 هوة من مربع D6 و صفوف ايضا مثلا الصف الذي يحتوي على ارقام

1,8,15,17,24 هي من مربع C2 وطرف 11,12,13,14’15 هوة من الوصيطات Z ولا يلزم ان يكون الارقام بتسلس اي من صغير الى اكبير والعكس بل عشوائي

ارجوا ان اكون وفقت في شرح وشكرا

قام بنشر

السلام عليكم

الموضوع طويل وليس سهلا كما توقعت

عموما هذه محاولة غير كاملة ستسهل علي من يريد المحاولة

تفضل والمحاولة في الورقة TAREQ

سميت بعض المجالات للتسهيل

وهذا هو الكود



Sub distrb()

Dim w(5), A(5, 5), B(5, 5), RA(5), RB(5) As Variant, ch, wa, ASAS As Range


Set ch = Range("Choose")

Set ASAS = Range("ASASAT")

Set wa = Range("Waseet")

Set RS = Range("Result")

RS.ClearContents

[A9.AR100].Interior.ColorIndex = xlNone

If WorksheetFunction.CountA(ch) < 3 Then MsgBox ("Please Choose the 3 elements then press again !!"): Exit Sub


For Each t In ASAS

	If ch(1) = t Then adr1 = t.Address

	If ch(2) = t Then adr2 = t.Address

Next t

adr1 = Range(adr1).Offset(-6, -3).Address

adr2 = Range(adr2).Offset(-6, -3).Address

For i = 1 To 5		  ' عناصر الأساس الأول والثاني

	For j = 1 To 5

		A(i, j) = Range(adr1).Offset(i, j)

		Range(adr1).Offset(i, j).Interior.ColorIndex = 6

		B(i, j) = Range(adr2).Offset(i, j)

		Range(adr2).Offset(i, j).Interior.ColorIndex = 4

	Next j

Next i



For Each t In wa

	If ch(3) = t Then adr = t.Address

Next t

For i = 1 To 5	  'عناصر الوسيط

	w(i) = Range(adr).Offset(i, 0)

	RS(i, i) = w(i)

Next i



For i = 1 To 5	  ' each elment of Waseet

	For j = 1 To 5	  ' Get the right column in both arraies

		For k = 1 To 5

			If w(i) = A(j, k) Then col_1 = k

			If w(i) = B(j, k) Then col_2 = k

		Next k

	Next j

	For j = 1 To 5

	  RA(j) = A(j, col_1)

	  RB(j) = B(j, col_2)

   '   [bf19].Offset(j, 0) = A(j, col_1)

   '   [bg19].Offset(j, 0) = B(j, col_2)

	Next j

   ' [AZ19].Offset(i, 0) = col_1

   ' [AZ25].Offset(i, 0) = col_2


	 For j = i + 1 To 5   'rows

		If RS(i, j) > 0 Then GoTo 10

		For k = 1 To j - 1

			If RA(j) = RS(i, k) Then

				exchg = RA(j)

				RA(j) = RA(k)

				RA(k) = exchg

			End If

		Next k

			RS(i, j) = RA(j)

10	Next j


	  For j = i + 1 To 5  'columns

		If RS(j, i) > 0 Then GoTo 20

				For k = 1 To j - 1

			If RB(j) = RS(k, i) Then

				exchg = RB(j)

				RB(j) = RB(k)

				RB(k) = exchg

			End If

		Next k

			RS(j, i) = RB(j)

20	Next j

Next i



End Sub

وهذا هو المرفق

تفضل

المربعات2.rar

قام بنشر

أخي طارق

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

أولاً أريد أن أشكركم جزيل الشكر و التقدير لما بذلته من جهد ، جزاكم الله ألف خير

سلمت يداك على ما هذا المجهود الكبير ورائع واحترفي ، لأني هذا ما كنت أريد برغم ان مجموع الارقام في المربع لايكون 65 ولاكن المهم هوة ان نجمع بين المربعات وانشاء الله اكمل البقية .

وكل الشكر والتقدير لجهودك .

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information