نقل او ترحيل بشرط ارجو المساعدة

[فراسكو]

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

ممكن معادلة او كود في ترحيل والشرح في المرفق وشكرا

موقف.rar

[رجب جاويش]

السلام عليكم

تفضل أخى

حل بمعادلات الصفيف

موقف 1.rar

[فراسكو]

السلام عليكم ولا استطيع ان اقول غير بارك الله فيك يا استاذي العزيز وانا جاري العمل بهذا الملف الراقي . اخوك فراس العراقي

[الخالدي]

إضافة إلى حل الفاضل رجب

حل اخر بالكود

Sub AL_KHALEDI()

a = "F3:I248": b = "D3:D248"

Range(a).ClearContents

ReDim vA(Range(a).Columns.Count + Range(a).Column)

Dim cl_b As Range, cl_a As Range

For Each cl_b In Range(b): For Each cl_a In Range(a).Rows(0).Columns

   If cl_a = cl_b Then

	 vA(cl_a.Column) = vA(cl_a.Column) + 1

	 cl_a.Offset(vA(cl_a.Column), 0).Value = cl_b.Offset(0, -1).Value

	 Exit For

   End If

Next cl_a: Next cl_b

End Sub

في أمان الله

موقف2.rar

[فضل حسين]

الخالدى باشا

كود عظيم وجميل وعمل رائع كما تعودنا دائما من استاذنا الكبير الخالدى باشا

ولكن عند محاولة فهم الكود لم استطيع فهم الفكرة الرئيسية للكود

فمثلا لم افهم

(ReDim vA(Range(a).Columns.Count + Range(a).Column

فهل هذا اعلان ولاايه بالضبط وفكرة وجود for each مرتين بهدف مادا

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

والف مليون شكر للاستاذ الفاضل الخالدى باشا

[فراسكو]

السلام عليكم بالنسبة الي انا سعيد بهذا العمل جدا فهل ممكن يكون تلوين كل رقم برقم يعني القائمة a الرقم 1100 اريده بلون وعند ترحليه الى سمقر يكون بنفس اللون اتمنى ان تساعدوني في هذا الملف كوني محتاحه في عملي واتمنى من الله ان يحفظكم لخير العمل وهل يكون فيه صفحة دخول الى البرنامج يعني س1 صفحة وس2 صفحة وهكذا للباقي يعني ملف كامل مع ارتباطاته . اخوكم فراس العراقي

تم تعديل مارس 25, 2012 بواسطه فراسكو

[فراسكو]

منتظر ردكم وبارك الله فيكم

[الخالدي]

اخي الكريم

تم اضافة التلوين الى الكود

Sub AL_KHALEDI()

a = "D3:D248"

b = "F3:I248"

Application.ScreenUpdating = False

Range(b).ClearContents

Range(a & "," & Range(a).Offset(0, -1).Address).Interior.ColorIndex = 0

ReDim vA(Range(b).Columns.Count)

Dim cl_a As Range, cl_b As Range

For Each cl_a In Range(a)

   For Each cl_b In Range(b).Rows(0).Columns

	  If cl_b = cl_a Then

		 r = cl_b.Column - Range(b).Column + 1

		 vA(r) = vA(r) + 1

		 Range(b).Rows(vA(r)).Columns(r).Value = cl_a.Offset(0, -1).Value

		 l = 36 - r Mod 56 + 1

		 Range(b).Rows(vA(r)).Columns(r).Interior.ColorIndex = l

		 cl_a.Offset(0, -1).Interior.ColorIndex = l

		 Exit For

	  End If

   Next cl_b

Next cl_a

Application.ScreenUpdating = True

End Sub[/size]

[size=4]

اما بخصوص بقية طلبك فليس لدي وقت لعمله ربما احد الاخوة يساعدك

موقف3.rar

[الخالدي]

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

شكرا اخي فضل على المرور الكريم

واعتذر عن تاخر ردي على الموضوع  بسبب  انقطاعات الكهرباء في مدينتي

 ReDim vA(Range(b).Columns.Count) 

وجدت مثل هذا السطر في بعض الاكواد  ولا علم لي بتفاصيل كثيرة عنه وربما احد الخبراء  يعطينا توضيح اكثر واعتقد انه إعلان عن صفيف من المتغيرات باسم vA وعدد المتغيرات في هذا الصفيف مرتبطة بعدد الاعمدة في النطاق والسطر أستخدم في الكود لغرض تخزين رقم صف تعبئة الخلايا  بحيث يكون كل متغير خاص بعمود محدد وللإشارة إلى احد المتغيرات في الصفيف نكتب اسم الصفيف ثم قوسين ونضع بين القوسين رقم يمثل منزلة او رتبة المتغير في الصفيف

 vA(r) = vA(r) + 1 

السطر هنا يقوم بزيادة 1 الى القيمة السابقة للمتغير  حيث  r يمثل موقع المتغير في الصفيف  

علما انه يمكن الاعلان عن  صفيف يحتوي متغيرات وموزعة على  صفوف وأعمدة

وبخصوص For Each

فالأولي تختص بارجاع قيم خلايا العمود F3:I248

الثانية تقوم بمقارنتها بالخلايا أعلى النطاق F3:I248 حيث (Range(b).Rows(0).Columns)   هو(F2:I2) ثم إرجاع رقم العمود في حال التطابق

ردي على عجل ارجوا المعذرة

في امان الله

[فراسكو]

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

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

انا اطمع بكرمكم ولا تحرمونيمن علمكم وبارك الله فيكم

اخوكم فراس العراقي

[فراسكو]

انا منتظر ردكم

[رجب جاويش]

أخى الفاضل / فراس

هذا تصور مبدئى لطلبك الثانى

أرجو دراسة المرفق وتحديد التعديدلات التى تريدها وإن شاء الله يتم عمل ما تريد

وان كان هذا ما تريد سوف يتم اجراء تعديل لترحيل الارقام من الصفحة الرئيسية الى الصفحات الخاصة بها

أخوك / رجب جاويش

موقف 1.rar

[فراسكو]

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

الاخ رجب جاويش

بارك الله فيك وبصراحة العمل هو المطلوب والحمد لله افادني كثيرا وشكرا مرة اخرى اخوك فراس العراقي .