ابو حمادة

شكرا ليك اخى واستاذي الغاالي وجزاك الله كل خير

تاريخ.rar

السلام عليكم ورحمة الله تعالى وبركاته اساتذتى الكرام عندي شيت اسمه (add) فى العمود(B) به اسماء كتيره عند عمل بحث بتقبلنى مشكله بسبب الحروف المتشابهه الف بالهمزه (أ) او بدون همزه (ا) و حرف الهاء (ة) بنقطتين او بدون (ه) و حرف الياء فى اخر الكلمه (ي) بتقطتين او بدون(ى) وبعض الاسماء مثل عبدالله - عبدالرحمن - عبداللطيف - عبدالرحيم لا يوجد مسافه بينهما واسماء اخرى بها مسافه واسماء اخرى بها مسافتين بدل مسافه واحده كلها اخطاء بسبب عدم الادخال بطريقه صحيحه وموحده محتاج كود يعمل الاتى يصحح الاسماء المدخله بطريقه موحده يتم تغيير اي حروف ( أ - ة - ي ) الى ( ا - ه - ى ) بدون همزات او نقط وايضا يتم وضع مسافه بين الاسماء مثل عبد الله عبد الرحمن اى اسم مثل هذه الاسماء واذا كان يوجد فى بعض الاسماء مسافتين يمسح مسافه بحيث تكون مسافه واحده بين كل اسم ويلغي اي مسافه عند اخر الاسم وجزاكم الله خيرا

السلام عليكم ورحمة الله تعالى وبركاته اساتذتى الكرام الى خبراء الاكسل محتاج مساعده من حضراتكم ومش عارف ينفع ولا صعب الملف عباره عن صفحة add النطاق من (DN6:JF10000) المعيار الاول هو عمود الاسم (B6:B10000) المعيار الثانى هو عمود السنه الحاليه هو فى (JR6:JR10000) صفحة ArchiveS النطاق من (B4:ET10000) المعيار الاول هو عمود الاسم ( EU4:EU10000) المعيار الثانى هو عمود السنه الحاليه هو فى (FF4:FF10000) اذا تطابقت المعايير يتم الاتى يتم جمع البيانات الموجوده لكل موظف في صفحة add علي البيانات التى تخص نفس الموظف في صفحة ArchiveS اذا كانت البيانات لنفس العام بحيث بدل ماضيف 12 شهر فى الارشيف يتم جمعهم على بعض في الارشيف لعدم تقل الملف توضيح للمطلوب شرح موضح عندي ملف به عدد اسماء كثيره تقريبا 10 الاف اسم كل شهر بيتم حفظ المبالغ التى تخص كل واحد فى الارشيف ودا بيتقل الملف لان كل شهر بضيف 10الاف اسم فى الارشيف عايز بدل مايتم اضافه الاسم كل مره فى الارشيف يتم جمع المبالغ التى تخص كل واحد واضافتها على المبالغ التى تخصه فى الارشيف بدلا من اضافته مره اخرى يعني كل شهر اضغط على مفتاح جمع المبالغ فى الارشيف يتم جمع المبالغ التى تخص كل واحد من صفحة add الى صفحة الارشيف واذا كان يوجد اسم مضاف جديد وليس له اي بيانات فى الارشيف سابقا يتم اضافته فى الارشيف اسفل البيانات الشروط ان يكون المبالغ دي لنفس العام حسب المعيار الموجود فى العمود السنه الحاليه وتاريخ اليوم بحيث يتم تجميع جميع المبالغ الشهريه لكل عام على حده وعند انتهاء العام يتم اضافه جميع البيانات الموجوده في صفحةadd للارشيف اسفل بيانات العام السابق ونبدا عام جديد على حده فى الارشيف اتمنى اكون قدرت اوضح المطلوب وجزاكم الله خيرا ملف Test1.rar

هو المنتدي مبقاش فيه حد موجود ولا ايه مبقاش فيه ردود من اي حد نهائي ليه ؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟

السلام عليكم ورحمة الله تعالى وبركاته اساتذتى الكرام كل عاملا وانتم بخير ارجو من اساتذتى الافاضل اهل الخبره مساعدتى فى هذا الملف هذا الملف من عمل الاستاذ القدير عبد الله باقشير محتاج اضافه كود يعمل الاتى كما واضح فى الصورة عند اختيار اي اسم من القائمه الفرعيه يتم وضع الاسم الذي يتم اختياره فى مربع (Textbox1) كما وااضح فى الصورة المرفقه ملف قوائم مخصصة على الفورم باستخدام كومندبار+2.rar وجزاكم الله كل خير

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

السلام عليكم ورحمة الله وبركاته حولت احمل هذا الملف لكن عند التحميل وفك الضغط يظهر فشل

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

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

السلام عليكم ورحمة الله تعالى وبركاته استاذي الغالى عبدالله باقشير كل عام وانت بخير وعي سعيد عليك وعلى الاسرة وكل المسلمين استفسار حول هذا الموضوع لو ممكن انا استخدمت الملف وعدلت عليه ويوجد قائمه فرعيه بها عدة اسماء المطلوب هل من الممكن عند اختيار اسم من القائمه الفرعيه يتم نقل هذا الاسم لـ تكست بوكس (TextBox1) انا حولت اطبق هذا ولم استطع هل دا ممكن تنفيذه ولا لاء ولك منى تحياتى

شكرا ليك استاذي الغالي على مجهودكواهتمامك وربنا يجعله فى ميزانحسناتك يارب اجرب واشوف النتيجه بكرا لما ارجع من الشغل ان شاء الله

شكرا لاهتمامك استاذي الغالى مستني حضرتك اهم نقطه ركز فيها كيفيه تغيير مكان الجدول ال في ورقه2 الصورة المرفقه توضح مكان الجدول ال محتاجه فى ورقه2 انظر لاسماء الاعمده والنطاق للجدول حسب ماهو واضح فى الصورة ولك منى تحياتى

استاذ Sub Salim_filter_ME() Application.ScreenUpdating = False Dim Filtler_Rg As Range Dim copy_rg As Range Dim ro%, i% Dim m%: m = 3 Dim last_row Dim Targ_sh As Worksheet Dim arr(1 To 9) On Error GoTo 1 Set Targ_sh = Sheets("salim") last_row = Targ_sh.Cells(Rows.Count, 2).End(3).Row If last_row < 3 Then last_row = 3 Targ_sh.Range("b3:j" & last_row).ClearContents For i = 1 To 9 arr(i) = Targ_sh.Cells(2, i + 1) Next If Sheets("add").AutoFilterMode = True Then Sheets("add").AutoFilterMode = False Set Filtler_Rg = Sheets("add").Range("b1").CurrentRegion ro = Filtler_Rg.Rows.Count Set copy_rg = Filtler_Rg.Offset(1, 0).Resize(ro - 1).Columns(1) For i = 1 To 9 With Filtler_Rg .AutoFilter .AutoFilter Field:=3, Criteria1:="=" & Targ_sh.Range("l2") .AutoFilter Field:=2, Criteria1:="=" & arr(i) Filtler_Rg.Offset(1, 0).Resize(ro - 1, 1).SpecialCells(xlCellTypeVisible).Copy _ Destination:=Targ_sh.Range("b" & m).Offset(, i - 1) End With Next 1: Erase arr Sheets("add").AutoFilterMode = False Application.ScreenUpdating = True End Sub الملف مرفق salim_filter_by sectionr.xls استاذ سليم حاصبيا اتمني شرح الكود لاستفيد منه حيث ان الملف الاساسي هو كما يلى عمود الاسم هو (B) عمود نوع العمل هو (H) عمود اسم الفرع (K) بالنسبه لنطاق الجدول ازي اغير مكانه محتاجه يكون فى النطاق (EA:Ej) ولك منى كل الشكر واالاحترام استاذ shreif mohamed اتمني شرح الكود لاستفيد منه حيث ان الملف الاساسي هو كما يلى عمود الاسم هو (B) عمود نوع العمل هو (H) عمود اسم الفرع (K) بالنسبه لنطاق الجدول ازي اغير مكانه محتاجه يكون فى النطاق (EA:Ej) ولك منى كل الشكر واالاحترام

اعرف بس ازي اغير مكان الجدول عايز اغير نطاق الجدول الى (EN:Ei)

شكرا استاذي الغالي الكوديعمل جيدا ولكن حضرتك غيرت الاعمده فى شيت add الملف الرئيسي عمود الاسم هو (B) عمود نوع العمل هو (H) عمود اسم الفرع (K) بالنسبه للجدول الموجود فى شيت (Salim ) محتاجه يكون فى النطاق (EA:Ej) ولك منى جزيل الشكر ممكن شرح للكود عشان اقدر اطبقه على الملف الاصلي

شكرا لاهتمامك استاذي الغالي وجعله الله فى ميزان حسناتك ينفع كود افضل لان المعادلات بتقل الملف

صوره من الجدول المرادنقل الاسماء اليه ملف يوضح الملوب Book1.rar وجزاكم الله كل خير

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

السلام عليكم ورحمة الله الموضوع صعب ارجو المساعدهمناهل الخبره رجااااااء المطلوب تعديل هذا السطر محتاج تعديل هذا السطر اذا كان ناتج النسبه المئويه اقل من قيمة الحد الادنى (50 جنيه) يتم رفعه الى 50 جنيه واضافتها لقيمة العمود (R) C2.Offset(0, 9) = Format(Round(C2.Offset(0, 9) + C2.Offset(0, 9) * Me.TextBo_05.Value / 100, 2)) او ان كان هناك كود اخر ينفذالمطلوب ؟؟؟؟؟؟؟

السلام عليكم مافيش حد موجود

السلام عليكم ورحمة الله تعالى وبركاته كل عام وانتم والامه الاسلاميه بخير رجاء المساعده عندي ملف به كود محتاج تعديله حسب المطلوب المعيار فى العمود (i) يوجد عمودين كل عمود به قيمه ليتم استخراج النسبه المئويه منهم حسب اختياري من اليوزر فورم العمود الاول (Q) العمود الثاني (R) يوجد تكست بوكس فى اليوزر فورم اسمه (TextBo_05) ودا لتحديد النسبه المئويه ويوجد ايضا تكست بوكس فى اليوزر فورم اسمه (TextBo_06) ودا لتحديد قيمة الحد الادنى ويوجد ايضا قائمه منسدله اسمه (TexR_01) لاختيار من اريد اضافه النسبه لهم المطلوب عند تنشيط (CheckBo_06) يتم حساب قيمة العمود (Q) فى النسبه المئويه واذا كان الناتج اقل من قيمة الحد الادنى يتم اضافه قيمة الحد الادنى على القيمة الموجوده فى العمود (Q) وان كان ناتج النسبه اكبر من الحد الادنى يتم اضافه الناتج على قيمة العمود (Q) واذا تم تنشيط (CheckBo_07) يتم حساب قيمة العمود (R) فى النسبه المئويه واذا كان الناتج اقل من قيمة الحد الادنى يتم اضافه قيمة الحد الادنى على القيمة الموجوده فى العمود (R) وان كان ناتج النسبه اكبر من الحد الادنى يتم اضافه الناتج على قيمة العمود (R) مثال الحد الادنى 50 جنيه قيمة العمود = 100 النسبه = 10% يعني اذا تم حساب قيمة العمود فى النسبه هكذا 100*10% = 10 10 يعني اقل من الحد الادنى وهو 50 الناتج المفروض = قيمة العمود (Q) + الحد الادنى 50 الناتيج = 150 بدلا من 110 بمعني اخر اريد اقول لسطر الحساب اضرب قيمة العمود(Q) فى النسبه واذا كان الناتج اقل من الحد الادنى يرفع الناتج الى الحد الادنى ويتم جمعه الى قيمة العمود (Q) اتمنى اكون قدرت اوصل المطلوب مرفق ملف Private Sub CommandButton1_Click() Dim ws As Worksheet: Set ws = Sheets("add") Dim CL, C2 As Range Application.ScreenUpdating = False ' _________________________________________________________________________________ For Each CL In ws.Range("i6:i" & ws.Range("i" & Rows.Count).End(xlUp).Row) If Me.CheckBo_06.Value = True Then If CL.Value = Me.TexR_01.Value Then محتاج تعديل هذا السطر اذا كان ناتج النسبه المئويه اقل من قيمة الحد الادنى جنيه (50 جنيه) يتم رفعه الى 50 جنيه واضافتها لقيمة العمود (R) CL.Offset(0, 9) = Format(Round(CL.Offset(0, 9) + CL.Offset(0, 8) * Me.TextBo_05.Value / 100, 2)) End If Next ' _________________________________________________________________________________ If Me.CheckBo_07.Value = True Then For Each C2 In ws.Range("i6:i" & ws.Range("i" & Rows.Count).End(xlUp).Row) If C2.Value = Me.TexR_01.Value Then محتاج تعديل هذا السطر اذا كان ناتج النسبه المئويه اقل من قيمة الحد الادنى (50 جنيه) يتم رفعه الى 50 جنيه واضافتها لقيمة العمود (R) C2.Offset(0, 9) = Format(Round(C2.Offset(0, 9) + C2.Offset(0, 9) * Me.TextBo_05.Value / 100, 2)) End If Next Application.ScreenUpdating = True End Sub Test1.rar

شكر لكم اساتذتى الافاضل ولكن هناك عدة مشاكل الكود اشتغل لما اضفط ( Next ) قبل End sub ولكن تقيل جدا جدا فى التنفيذ والنتيجه خطأ وايضا هذا السطر بالكود الاول N.Offset(0, 118) = Format(Round(N.Offset(0, 171) + N.Offset(0, 172) + N.Offset(0, 173) + N.Offset(0, 174), 2)) لم يدرج فى الكود هذا علما انا هذا السطر يجب تنفيذه قبل مسح باقي البيانات فلذلك النتيجه خطأ هل هناك حل لتخفيف الكود علما ان الكود الاول بالرغم انه طويل ولكن اسرع من هذا الكود مع انه صغير ولكم منى جزيل الشكر

شكرا لاهتمامك استاذي الفاضل انا جربت الكود بتظهر رسالة خطأء وبيتم تحديد اخر سطر فى الكود ( 1 End Sub ) كما واضح فى الصورة

السلام عليكم ورحمة الله تعالى وربركاته كل عام وانتم بخير بمناسبه حلول شهر رمضان المعظم اعاده الله علينا وعليكم وعلى امة المسلمين باليمن والخير والبركات استفسار 1- لدى ملف به عدد اعمده كثيره جدا وصفوف تتخطي 10 الاف صف الكود يعمل كما اريد ولكن الكود طويل جدا وبياخد وقت فى تنفيذ الكود عمل الكود عباره عن اذا تحقق الشرط يتم مسح بيانات الصف باكمله ماعدي بعض الاعمده لها عمليات حسابيه هل من الممكن اختصار الكود المرفق لكي ينفذ ما اريد بسرعه افضل من هذا Sub Click3() On Error GoTo 1 Dim ws As Worksheet: Set ws = Sheets("add") Dim N, C2 As Range ' On Error Resume Next For Each N In ws.Range("H6:H" & ws.Range("B" & Rows.Count).End(xlUp).Row) If N.Value = "محمود" Or N.Value = "احمد" Then Application.ScreenUpdating = False N.Offset(0, 111) = "" N.Offset(0, 112) = "" N.Offset(0, 113) = "" N.Offset(0, 114) = "" N.Offset(0, 115) = "" N.Offset(0, 116) = "" ' N.Offset(0, 117) = "" N.Offset(0, 118) = Format(Round(N.Offset(0, 171) + N.Offset(0, 172) + N.Offset(0, 173) + N.Offset(0, 174), 2)) N.Offset(0, 119) = "" '' N.Offset(0, 120) = "" '' N.Offset(0, 121) = "" '' N.Offset(0, 122) = "" '' N.Offset(0, 123) = "" '' N.Offset(0, 124) = "" '' N.Offset(0, 125) = "" '' N.Offset(0, 126) = "" '' N.Offset(0, 127) = "" '' N.Offset(0, 128) = "" '' N.Offset(0, 129) = "" '' N.Offset(0, 130) = "" '' N.Offset(0, 131) = "" '' N.Offset(0, 132) = "" '' N.Offset(0, 133) = "" '' N.Offset(0, 134) = "" '' N.Offset(0, 135) = "" '' N.Offset(0, 136) = "" '' N.Offset(0, 137) = "" '' N.Offset(0, 138) = "" '' N.Offset(0, 139) = "" '' N.Offset(0, 140) = "" '' N.Offset(0, 141) = "" '' N.Offset(0, 142) = "" '' N.Offset(0, 143) = "" '' N.Offset(0, 144) = "" '' N.Offset(0, 145) = "" '' N.Offset(0, 146) = "" '' N.Offset(0, 147) = "" '' N.Offset(0, 148) = "" '' N.Offset(0, 149) = "" '' N.Offset(0, 150) = "" '' N.Offset(0, 151) = "" '' N.Offset(0, 152) = "" '' N.Offset(0, 153) = "" '' N.Offset(0, 154) = "" '' N.Offset(0, 155) = "" '' N.Offset(0, 156) = "" '' N.Offset(0, 157) = "" '' N.Offset(0, 158) = "" '' N.Offset(0, 159) = "" '' N.Offset(0, 160) = "" '' N.Offset(0, 161) = "" '' N.Offset(0, 162) = "" '' N.Offset(0, 163) = "" '' ' N.Offset(0, 164) = "" N.Offset(0, 165) = Format(Round(N.Offset(0, 180) + N.Offset(0, 181), 2)) N.Offset(0, 166) = "" '' N.Offset(0, 167) = "" '' N.Offset(0, 168) = "" '' N.Offset(0, 169) = "" '' N.Offset(0, 175) = "" '' N.Offset(0, 177) = "" '' N.Offset(0, 178) = "" '' N.Offset(0, 179) = "" '' ' N.Offset(0, 180) = "" '' ' N.Offset(0, 181) = "" '' N.Offset(0, 182) = "" '' ' N.Offset(0, 183) = "" '' N.Offset(0, 184) = "" '' N.Offset(0, 185) = "" '' N.Offset(0, 186) = "" '' N.Offset(0, 187) = "" '' N.Offset(0, 188) = "" '' N.Offset(0, 189) = "" '' N.Offset(0, 190) = "" '' N.Offset(0, 191) = "" '' N.Offset(0, 192) = "" '' N.Offset(0, 193) = "" '' N.Offset(0, 194) = "" '' N.Offset(0, 195) = "" '' N.Offset(0, 196) = "" '' N.Offset(0, 197) = "" '' N.Offset(0, 198) = "" '' N.Offset(0, 199) = "" '' N.Offset(0, 200) = "" '' N.Offset(0, 201) = "" '' N.Offset(0, 202) = "" '' N.Offset(0, 203) = "" '' N.Offset(0, 204) = "" '' N.Offset(0, 205) = "" '' N.Offset(0, 206) = "" '' N.Offset(0, 207) = "" '' N.Offset(0, 208) = "" '' N.Offset(0, 209) = "" '' N.Offset(0, 210) = "" '' N.Offset(0, 211) = "" '' N.Offset(0, 212) = "" '' N.Offset(0, 213) = "" '' N.Offset(0, 214) = "" '' N.Offset(0, 215) = "" '' N.Offset(0, 216) = "" '' N.Offset(0, 217) = "" '' N.Offset(0, 218) = "" '' N.Offset(0, 219) = "" '' N.Offset(0, 220) = "" '' N.Offset(0, 221) = "" '' N.Offset(0, 222) = "" '' N.Offset(0, 223) = "" '' N.Offset(0, 224) = "" '' N.Offset(0, 225) = "" '' N.Offset(0, 226) = "" '' N.Offset(0, 227) = "" '' N.Offset(0, 228) = "" '' N.Offset(0, 229) = "" '' N.Offset(0, 230) = "" '' N.Offset(0, 231) = "" '' N.Offset(0, 232) = "" '' N.Offset(0, 233) = "" '' N.Offset(0, 234) = "" '' N.Offset(0, 235) = "" '' N.Offset(0, 236) = "" '' N.Offset(0, 237) = "" '' N.Offset(0, 238) = "" '' N.Offset(0, 239) = "" '' N.Offset(0, 240) = "" '' N.Offset(0, 241) = "" '' N.Offset(0, 242) = "" '' N.Offset(0, 243) = "" '' N.Offset(0, 244) = "" '' N.Offset(0, 245) = "" '' N.Offset(0, 246) = "" '' N.Offset(0, 247) = "" '' N.Offset(0, 248) = "" '' N.Offset(0, 249) = "" '' N.Offset(0, 250) = "" '' N.Offset(0, 251) = "" '' N.Offset(0, 252) = "" '' N.Offset(0, 253) = "" '' N.Offset(0, 254) = "" '' N.Offset(0, 255) = "" '' N.Offset(0, 256) = "" '' End If Next Application.ScreenUpdating = True 1 End Sub وجزاكم الله خيرا