hani_2007

والله احرجتموني بكرمكم

الف شكر لكل من ساهم في هذا الموضوع

الاخ يحيى يعطيك الف عافية على سرعة الرد

الاخ بن عليةتسلم يمينك هذا هو المطلوب بالضبط

الف شكر لكم والله الواحد يخجل من كرمكم

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

اخواني

المطلوب عمل زر امر لكود برمجي للبحث في العامود

A

واذا كان الرقم غير موجود في القائمه للعامود

A

يتم ادراج هذا الرقم الغيير موجود في العامود

C

شاكر مجهوداتكم المشهوده

Nr_not_in_the_list.rar

السلام عليكم

بعد تطبيق المثال على الملف الدي اريده اعطاني هذا الخطا

هذا لأنني لم أضع بالحسبان تلك العلامات الخاصة التي بالملف "علامات السالب" ------ ------ ---- --

وأيضا عدلت ترتيب السطرين التاليين واستبدلت كلمة "end" بكلمة " ## "

   Sheets(3).Cells(i, j - 1).ClearContents

                                Sheets(3).Cells(i, x + 1).Value = " ## "

الكود بعد التعديل أضفت خطوة لاستبدال أي علامة سالب بلاشيء Cells.Replace What:="-", Replacement:=""

Sub copy_2_end()

LstC = [IV1].End(xlToLeft).Column

LstR = [A65530].End(xlUp).Row


Range("A1", [A1].Offset(LstR - 1, LstC - 1)).Select

i = 1: j = 1: f_end = 0

Cells.Replace What:="-", Replacement:=""

	For Each ce In Selection

    	If f_end = 1 Then GoTo 10

5   		Sheets(3).Cells(i, j).Value = ce.Value

        	j = j + 1

            	If ce.Value = "end" Then


                	For x = j - 2 To 1 Step -1

                    	If Sheets(3).Cells(i, x) <> "" Or Left(Sheets(3).Cells(i, x), 1) <> "-" Then

                        	Sheets(3).Cells(i, j - 1).ClearContents

                        	Sheets(3).Cells(i, x + 1).Value = " ## "

                        	Exit For

                    	End If

                	Next x

            	i = i + 1

            	j = 1

            	f_end = 1

            	End If

    	GoTo 20

10  	If ce.Value <> "" Then f_end = 0: GoTo 5

20

	Next ce

	[A1].Select

End Sub

بارك الله فيك و جعله في ميزان حسناتك و جزاك الله عنا كل خير

السلام عليكم

أخي العزيز

تفضل المرفق ينقل كما تريد للورقة3

وهذا هو الكود يمكنك تعديلها إلي ورقة2 باستبدال كل

 Sheets(3)

إلي

 Sheets(2)

Sub copy_2_end()

LstC = [IV1].End(xlToLeft).Column

LstR = [A65530].End(xlUp).Row


Range("A1", [A1].Offset(LstR - 1, LstC - 1)).Select

i = 1: j = 1: f_end = 0

	For Each ce In Selection

    	If f_end = 1 Then GoTo 10

5   		Sheets(3).Cells(i, j).Value = ce.Value

        	j = j + 1

            	If ce.Value = "end" Then


                	For x = j - 2 To 1 Step -1

                    	If Sheets(3).Cells(i, x) <> "" Then

                        	Sheets(3).Cells(i, x + 1).Value = "end"

                        	Sheets(3).Cells(i, j - 1).ClearContents

                        	Exit For

                    	End If

                	Next x

            	i = i + 1

            	j = 1

            	f_end = 1

            	End If

    	GoTo 20

10  	If ce.Value <> "" Then f_end = 0: GoTo 5

20

	Next ce

[A1].select

End Sub

أنظر للورقة 3 قبل ضغط زر الكود

تفضل المرفق

تسلم يمينك اخي طارق و الله تعجز الكلامات عن شكرك

الاخ طارق بعد تطبيق المثال على الملف الدي اريده اعطاني هذا الخطا

Sheets(3).Cells(i, j).Value = ce.Value

ماهي المشكله

الانتقال الى خليه في حالة توفر شرط1.rar

السلام عليكم

أخي العزيز

تفضل المرفق ينقل كما تريد للورقة3

وهذا هو الكود يمكنك تعديلها إلي ورقة2 باستبدال كل

 Sheets(3)

إلي

 Sheets(2)

Sub copy_2_end()

LstC = [IV1].End(xlToLeft).Column

LstR = [A65530].End(xlUp).Row


Range("A1", [A1].Offset(LstR - 1, LstC - 1)).Select

i = 1: j = 1: f_end = 0

	For Each ce In Selection

    	If f_end = 1 Then GoTo 10

5   		Sheets(3).Cells(i, j).Value = ce.Value

        	j = j + 1

            	If ce.Value = "end" Then


                	For x = j - 2 To 1 Step -1

                    	If Sheets(3).Cells(i, x) <> "" Then

                        	Sheets(3).Cells(i, x + 1).Value = "end"

                        	Sheets(3).Cells(i, j - 1).ClearContents

                        	Exit For

                    	End If

                	Next x

            	i = i + 1

            	j = 1

            	f_end = 1

            	End If

    	GoTo 20

10  	If ce.Value <> "" Then f_end = 0: GoTo 5

20

	Next ce

[A1].select

End Sub

أنظر للورقة 3 قبل ضغط زر الكود

تفضل المرفق

تسلم يمينك اخي طارق و الله تعجز الكلامات عن شكرك

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

اخواني ارجوا منكم المساعدة في طلبي هذا وهو:

المطلوب هو طريقة ادراج البيانات التي في كل خليه في ورقة2 على شكل افقي جنب بعض و عند الوصول الي كلمة

end

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

end

ثم يكرر هذا الاجراء حتى نهاية الورقه ليصبح الناتج مثل الذي في ورقة2

الانتقال الى خليه في حالة توفر شرط.rar

اشكرك شكرا جزيلا

بس ممكن اضيف طلب ثاني

معليش سامحوني اذا زودها

- ممكن اذا كانت اكبر من حجم الورقة هل اقدر اخليها بحجم الورقه

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

سارفق ملف بالمطلب

و ارجوا المعذره مره اخرى مع فائق شكري و احترامي

لابد من نسخ الخلايا أولا لنطاق جديد بحيث يتم إلغاء الفراغات

ثم طباعة النطاق الجديد

استخدم الكود التالى لتنظيم الخلايا كما أردت

و من ثم

تعيين نطاق الطباعة للنطاق الجديد

هذا ما يحضرنى الآن

وربما هناك حلول أفضل

لكنها تحتاج لوقت

Sub Button1_Click()

Dim myrng As Range, myc As Range, i As Integer, j As Integer

i = 1

j = 6

For x = 1 To 4

    Set myrng = Range(Cells(i, j - 5), Cells(10, j - 5))

        For Each myc In myrng

            If myc <> "" Then

                myc.Copy Cells(i, j)

                i = i + 1

            End If

        Next myc

    i = 1

    j = j + 1

Next x

    Range("F1:I10").Select

    ActiveSheet.PageSetup.PrintArea = "$F$1:$I$10"

End Sub

الملف المرفق

PRINT2.rar

السلام عليكم

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

ولقد ارفقت ملف لشرح المطلوب

وشكرا لكم

PRINT1.rar

شكرا جزيلا والله افادتني كثير

السلام عليكم

بامكانك استخدام معادلة الصفيف التالية:

{=INDIRECT("R" & MAX(IF(B2:B10="";"";ROW(B2:B10)))&"C";0)}

ملاحظة:

بعد ادخال الصيغة

اضغط CTRL+SHIFT+ENTER.

شاهد المرفق

ما شاء الله تبارك الله عليك يا اخ خبور

اللهم سدد خطاك

وكل عام و انتم بخير

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

أخي الكريم جرب الفورم التالي بشرط عدم وجود خلايا فارغة في القائمة بحيث يأخذ أخر قيمة في القائمة

=INDEX(B3:B10;NBVAL(B3:B10))

الاخ مصطفى شكرا جزيلا على المشاركة ولكن هناك خطا في هذه المعادلة

INDEX(B3:B10,COUNTA(B3:B10))

عموما الاخ خبور ماقصر و جاب الغايبه وكلكم ان شاء الله اخوان وحبايب

الأخ العزيز هاني

بالملف المرفق فكرة ارجو ان تكون ما تحتاج .

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

والف شكر لك مره اخرى

السلام عليكم

الاخوه الاعزاأ

ارجو منكم ناتج البحث بهذه الطريقة الموجوده يالملف المرفق

وشكر لكم

SER.rar

الاستاذ طارق الف شكر

فعلا هذا هو طلبي

واعجبتني التعديلات

فعلا تعجز الكلمات عن شكركم

اخوكم هاني

انا آسف مع الاستعجال ادخلت الوقت غلط

تم تعديل الملف

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

وشكرا

trip1.rar

السلام عليكم

شكرا على سرعة تجاوبكم وهو ما عرف عنكم

بالنسبة لحساب الوقت يكون عن طريق داله

بالنسبة لمدة الرحلة فانا عملت لها داله لحساب مدة الرحله

والمطلوب هو 1- حساب اذا كانت الرحلة فيها سفر في الليل لانه له حسابات ماديه تختلف عن السفر في الصباح عشان كده لازم اعرف المدة التي كان السائق فيها يسافر ليلا عشان تحاسبه عليها على حسب مده سفره في الليل يعني لو كانت مدة رحلته 12ساعة وكان من ضمن 12ساعة هناك ساعات سفر في الليل مابين 6م الى 4ص يعني لو كانت من ضمن ال12ساعة ساعه واحده كانت في الليل يتم ادراجها في خانة مستقله عشان تنحسب لوحدها, فلمطلوب فصلها عن مدة الرحلة ليتم حسابها لوحدها.

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

انشاء الله اكون قدرت اوصل الفكره المطلوبه

المشكله ان الملف الاصلي كبير جدا وكل الداته اللي فيه كلها حسابات منول

شكرا لكم مره اخرى

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

الاخوة الاعزاء

ارجوا منكم مساعدتي في هذا الملف

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

وحساب مدة البقاء في مدينة بالساعات

شاهد الملف المرفق لتوضح الصوره

ولكم مني جزيل الشكر

اخوكم

trip1.rar

الف شكر جاري التحميل

الاستاذ خبور الف شكر على سرعة الرد طبعا هذا شيئ من غريب منك

جاري تحميل الملف و التجربه وكل عام و انت بالف صحة و عافة و دايم للمنتدى

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

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

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

انشاء الله اكون قدرت اوصل الفكره وكل عام و انت بخير و رمضان كريم

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

اعزائي ارجوا منكم المساعدة في هذا الجدول

انظر المرفقات

المطلوب : بعد إدخال المعطيات من المستخدم و هي ثلاثة ارقام الرقم الاول يكون للجدول (أ) و الرقم الثاني يكون للجدول (ب) و الرقم الثالث يكون للجدول (ج) و بعد مقارنة المعطيات من المستخدم بمحتوايات الجدول يكون الناتج من محتويات الجدول (د)

وكل عام و انتم بخير

TABLE(1).rar

انظر هنا:

http://office.microsoft.com/ar-sa/word/HP051899431025.aspx

وستحصل على شيء شبيه بالملف المرفق

إذا كان الوورد لديك إصدار 2007 فانظر هنا:

http://office.microsoft.com/ar-sa/word/HA100307481025.aspx

_______________________________________________________________________

شكرا جزيلا و يعطيكم الف عافية

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

اعزائي اريد معرفة طريقة عمل خانة اختيار CheckBox

و الطريقة التي اريدها هي

عند الدخول الى الصفحة تكون الخانة (الخانات) غير محدده

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

اذا كانت الخانات كالتالي:

الخانة الاولى : طلب سلعة

الخانة الثانية: استفسار عن سلعة

الخانة الثالثة: طلب إرجاع سلعة

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

اتمنى ان تكون الفكرة واضحة

و شكرا لكم

مع تمنياتي لكم بدوام الصحة و العافية

تسلم اخوى طارق

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

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

كيف استطيع عرض معلومات العضو في الخانات في اعلى الجدول عند اختيار رقم العضو فقط

اليكم الملف المرفق لتوضيح طلبي

و شكرا لتعاونكم

Book000.rar