طارق محمود

السلام عليكم بعد إذن أساتذتي وإخواتني : أحمد زمان وعبدالله المجرب أخي العزيز تعرف أن عنوان الخلية في الإكسل يتكون من شقين حرف يدل علي العمود ، رقم يدل علي السطر إن كانت الخلية المراد نسخها متغيرة بمعني إن نسخت منها للأسفل أو لليمين مثلا يتغير هدف النسخ أيضا للأسفل ولليمين بالتبعية (أو اليسار في حالة تنسيق اللغة العربية) لكن إن أردت تثبيت خلايا الصف الثاني مثلا ، أي النسخة من B2 أو C2 أو أي خلية بالصف الثاني بحيث تأخذ نسخة من المعادلة للأسفل ولايتغير هدف النسخ بالإزاحة فتضع علامة الدولار قبل رقم الصف فتكون هكذا B$2 ونفس الحال مع العمود أو معهما سويا وعلي هذا فمعادلة اخي أحمد في الخلية D2 هي =SUMIF('رصد مبيعات'!$B$2:$B$9654,$B2,'رصد مبيعات'!D$2:D$9654) سنركز علي جزء واحد منها وهو =SUMIF('رصد مبيعات'!$B$2:$B$9654,$B2,'رصد مبيعات'!D$2:D$9654) وهو B$2 لو تم كتابته بهذه الطريقة (في الخلية D2) ......B2:......... وأخذت نسخة منه للأسفل (في الخلية D3) لوجدت المعادلة في D3 أصبحت ......B3:......... ولكن وضع الدولار قبل رقم الصف يثبت هذا الرقم عند النسخ الرأسي ومثل ذلك في الأفقي

السلام عليكم أضفت لك سطر ترحيل هامش الخلية بمقدار 1 كما في G11 وهو هذا السطر لكلا الكودين .IndentLevel = 1 وكذلك اضفت سطرين في أول الكود لإيقاف عمليات الحساب وتغير الشاشة مع استرجاعهما في آخر الكود بغرض تسريع النتائج (حيث كانت بطيئة نسبيا وهما هذان في أول الكود Application.ScreenUpdating = False Application.Calculation = xlCalculationManual وهذان في آخره Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic جرب الكود الآن كاملا كالتالي Private Sub Worksheet_Activate() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For Each ce In UsedRange If IsNumeric(ce) = False Then GoTo 1 If ce.Value = 0 Then With ce .NumberFormat = "_(### ### ###_);[Red]_((### ### ###);_(--_);_(@_)" .HorizontalAlignment = xlCenter .IndentLevel = 1 .VerticalAlignment = xlCenter End With Else With ce .HorizontalAlignment = xlRight .IndentLevel = 1 .VerticalAlignment = xlCenter End With End If 1 Next ce Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub Private Sub Worksheet_Change(ByVal Target As Range) Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For Each ce In UsedRange If IsNumeric(ce) = False Then GoTo 1 If ce.Value = 0 Then With ce .NumberFormat = "_(### ### ###_);[Red]_((### ### ###);_(--_);_(@_)" .HorizontalAlignment = xlCenter .IndentLevel = 1 .VerticalAlignment = xlCenter End With Else With ce .HorizontalAlignment = xlRight .IndentLevel = 1 .VerticalAlignment = xlCenter End With End If 1 Next ce Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub

السلام عليكم علي عجالة جرب أخي هذا التغيير Private Sub Worksheet_Activate() For Each ce In UsedRange If IsNumeric(ce) = False Then GoTo 1 If ce.Value = 0 Then With ce .NumberFormat = "_(### ### ###_);[Red]_((###### ###);_(--_);_(@_)" .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With Else With ce .HorizontalAlignment = xlRight .VerticalAlignment = xlBottom End With End If 1 Next ce End Sub Private Sub Worksheet_Change(ByVal Target As Range) For Each ce In UsedRange If IsNumeric(ce) = False Then GoTo 1 If ce.Value = 0 Then With ce .NumberFormat = "_(### ### ###_);[Red]_((###### ###);_(--_);_(@_)" .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With Else With ce .HorizontalAlignment = xlRight .VerticalAlignment = xlBottom End With End If 1 Next ce لم أجد وقتا لتجريبه أخبرني النتيجة

السلام عليكم أخي الحبيب / عيد جرب الكود التالي في حدث الورقة Private Sub Worksheet_Activate() For Each ce In UsedRange If ce.Value = 0 Then With ce .NumberFormat = "_(### ### ###_);[Red]_((###### ###);_(--_);_(@_)" .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With End If Next ce End Sub Private Sub Worksheet_Change(ByVal Target As Range) For Each ce In UsedRange If ce.Value = 0 Then With ce .NumberFormat = "_(### ### ###_);[Red]_((###### ###);_(--_);_(@_)" .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With End If Next ce End Sub

السلام عليكم أهلا ومرحبا بك اخي الكريم ،عضوا مفيدا مستفيدا بين إخوانك إن شاء الله تفضل أخي المرفق به ماطلبت احسب قيمة منتج2.rar

السلام عليكم تفضل المرفق M6.rar

السلام عليكم تفضل أخي المرفق وبه ماطلبت M5.rar

السلام عليكم أخي العزيز لقد جربت الكود ويعمل بلامشاكل المفروض أن تتغير فقط البيانات أو تحذف القديم جرب مرة أخري (بعد إضافة أمر حذف للبيانات التي تم نقلها) تفضل المرفق M4.rar

الحمد لله

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

أخي الحبيب / أبو أحمد عفوا لم أر ردك إلا بعد ان وضعت ردي

السلام عليكم أخي العزيز جرب هذا الكود Sub shift_to_Table1() Sheet3.Activate LR = [B10000].End(xlUp).End(xlUp).Row LR2 = Sheet1.[B10000].End(xlUp).End(xlUp).Row + 1 Range("A3:J" & LR).Copy (Sheet1.Cells(LR2, "A")) With Range("B3:J" & LR) .ClearContents .Interior.ColorIndex = xlNone End With End Sub

السلام عليكم أخي الحبيب ضع المعادلة التالية في الخلية L7 =COUNTIF($C$2:$C$20,K5) ثم المعادلة التالية في الخلية K7 =SUMPRODUCT(MAX((B2:B20)*(C2:C20=K5))) ثم المعادلة التالية في الخلية J7 =SUMPRODUCT(SMALL((B2:B20)*(C2:C20=K5),COUNTA(C2:C20)-L7+1))

السلام عليكم أهلا ومرحبا بك اخي بين إخوانك تفضل المرفق به ملف إكسل 2003 وآخر 2007/2010 فرق الوقت.rar

السلام عليكم أخي العزيز يمكنك ببساطة عمل التالي (1) كليك بالماوس علي إسم الورقة المراد إخفاؤها (إسم الورقة في أسفل الملف) إذا كنت تريد أكثر من ورقة ، إجعل الكليك بالماوس مع الـ Ctrl (2) كليك يمين بالماوس ستظهر لك بضعة خيارات ، إختر إخفاء هذا ينطبق علي جميع إصدارات الأوفيس 2003-2007-2010

السلام عليكم أخي العزيز (1) تم علاج ذلك (2) تم تعديلها (3) سهلة إن شاء الله ، غالبا ستحتاج أكواد ، لكن ليس عندي وقت الآن إن تدخل أحد الإخوة فأهلا ومرحبا وإلا انتظرني للغد تفضل المرفق وبه النقطتين الأوليين M3.rar

لابد ان يكون هناك فاصل بين الأرقام وإلا كانت رقما واحدا لنفرض أن الفاصل هو # أو : أو $ نفس الخطوات تحدد العمود الذي به البيانات (تظلله) ثم من قائمة Data - Data Tools - Text to Columns Delimited - Other ثم تضع الرمز الفاصل في المربع المجاور لـ Other وإذا كان الفاصل مثلا أكثر من حرف واحد مثلا 0100 ممكن تستبدل أولا الأحرف المقصودة برمز مثل السابق ذكرهم عن طريق Ctrl_H ثم نفس الإجراءات

السلام عليكم فعلا أخي الحبيب / يحياوي مجهود كبير ، تؤجر عليه إن شاء الله جزاك الله خيرا عن كل جهد بذلته وعن كل من سهلت عليه ليقرأ ويستفيد تقبل ودي واحترامي

السلام عليكم أخي العزيز كما قلت لك في ردي الأول فلتحدد العمود الذي به البيانات (تظلله) ثم من قائمة Data - Data Tools - Text to Columns Delimited - Space هذه الإجراءات ستفصل بين أي محتويات في اللية بناءا علي المسافة (Space)

السلام عليكم تفضل أخي المرفق به ماطلبت يصعب الرفع من هذا الجهاز للموقع المرفق علي الرابط http://www.4shared.com/rar/346aqPXd/__2.html

السلام عليكم بعد إذن اخي أبو أحمد نعم أخي يمكنك إدخال أرقام في الخلية I3 ثم إذا أردت الرجوع للمعادلات ، إضغط الزر الأحمر تفضل المرفق حاسبة اسهم2.rar

السلام عليكم أهلا ومرحبا بك أخي الكريم في المرفق تجد أنني تركت لك ورقة (الاصناف) كما هي وأخذت منها نسخة (المخزن) وأضفت بعض الأصناف الوهمية لتجربة المعادلات ثم في ورقة (صرف واضافة) تجد العمود M به معادلة لإكتشاف مكان الصنف بمقاسه في ورقة (المخزن) ثم المعادلة التي تضيف وتط رح من المخزون وأضفت لك أيضا تنسيق شرطي ، يلون الرصيد بالأحمر إذا قل عن الصفر وبالبرتقالي إن كان أقل من 10 تفضل المرفق M2.rar

السلام عليكم أخي العزيز لايوجد معيار ثابت فيما طرحت بالمعادلات يمكن بالأكواد لكن بدون أكواد ،يمكن الفصل بناءا علي أماكن الفراغات ولن يكون الناتج 4 أعمدة بل أكثر مثلا "عبد الله" ستكون "عبد" ، "الله" إن كان هذا يناسبك فلتحدد العمود الذي به البيانات (تظلله) ثم من قائمة Data - Data Tools - Text to Columns Delimited - Space جرب ولاتنسي أن تكون الأعمدة المجاورة للعمود المراد فارغة

السلام عليكم إضافة لحل أخي عبدالله المجرب (أبا أحمد) هذه الدالة أيضا تقوم بنفس العمل =RIGHT(A2)

السلام عليكم ماشاء الله جهد جميل أخي عيد وبعد إذن اخي محمد يحياوي بدأت بالتجميع في ملف واحد مؤقتا (الهيكل العام للكتاب) واللينكات الداخلية من وإلي صفحة الفهرس وكذلك أسماء جميع الدوال بأقسامها الإثناعشر وأنهيت نسخ الجزء الأول يبقي نسخ باقي الأجزاء كل دالة في مكانها (بسهولة باستخدام الهيبرلينك) والتنسيق العام للكتاب سأترك لكل من أراد المشاركة والتحسين إليكم المرفق XLS_VBA_Funcsions_ARABIC.rar