ياسر خليل أبو البراء

أخي الكريم أكرم يتم نسخ الكود ووضعه داخل موديول جديد ثم تنفيذ الكود عموماً إليك الملف المرفق فيه الكود بدون تنفيذ .. قبل التنفيذ شوف حجم المصنف (هتلاقي حوالي 5 ميجا) لتنفيذ الكود اضغط Alt + F8 من لوحة المفاتيح وانقر على الكود المسمى ExcelDiet ثم الأمر Run لتنفيذ الكود انتظر لمدة دقيقة تقريباً لأن الكود يعمل على كافة أوراق العمل الموجودة بالمصنف .. بعد الانتهاء من عمل الكود لا تنسى أن تحفظ المصنف .. أغلق المصنف بعد الحفظ .. اعمل كليك يمين على المصنف بعد إغلاقه ثم Properties وشوف حجم الملف الجديد (هتلاقي حجم الملف نزل إلى 36 كيلو بايت تقريبا) Last Price SALIM.rar

بارك الله فيك أخي الغالي ياسر أرى أنه طالما ستتعامل مع أرقام أكواد .. فالأفضل ألا يتم التعامل مع البيانات بشكل جزئي إنما بشكل كلي أقصد الجزء التالي LookAt:=xlPart, _ أن يتم استخدام كلمة xlWhole ليتم التعامل مع كامل محتويات الخلية .. هذا مجرد رأي وطبعاً الجزئي يستخدم في مواطن أخرى حسب الحاجة تقبل تحياتي

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

بسم الله ما شاء الله تبارك الرحمن يبدو أن المنتدى قد اكتسب محترف جديد .. واصل أخي الحبيب ياسر بلا فواصل وعلى رأي الصقر (حسام عيسى) إنت بتشتغلنا وتقول مبتديء (عيب عليك الكلام ده) الحمد لله أصبحت الحركة الياسرية في المنتدى هي المهيمنة للآن ياسر فتحي البنا .. ياسر الشيخ .. ياسر خليل أبو البراء .. ياسر العربي أبو أسيل .. والبقية تأتي تقبل تحياتي

أخي الكريم ناصر الكود كالتالي Sub GetIdFaster() Dim Rng As Range Dim LastRow As Long 'تعيين نطاق البيانات في ورقة البيانات الرئيسية With Sheet1 Set Rng = .Range("B3:C" & .Cells(.Rows.Count, 2).End(xlUp).Row) End With 'بدء التعامل مع ورقة النتائج With Sheet2 'تحديد آخر خلية بها بيانات في العمود الثاني LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row 'بدء التعامل مع العمود المراد استخراج النتائج به With .Range("C4").Resize(LastRow - 1) 'معادلة البحث عن الأسماء في ورقة البيانات في خانة العمود الثاني .Formula = "=IFERROR(VLOOKUP(B4," & Rng.Address(, , , True) & ",2,False),"""")" .Value = .Value End With End With End Sub نفس ما قيل عن الكود السابق هو نفس الكلام أو ارفق ملفك للعمل عليه إذا صعب عليك الأمر

أخي الحبيب أبو حنين إليك رابط الموضوع الجديد التالي وإن شاء الله يفيدك من هنا

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله أحياناً ما تحدث بعض المشاكل عند التعامل مع النوافذ الموجودة في محرر الأكواد .. كأن تختفي نافذة أو تتحرك نافذة من مكانها الذي تعودنا عليه ، وعند محاولة إرجاعها إلى مكانها لا نستطيع .. أنا مؤمن بمبدأ : بدلاً من تضييع الوقت في محاولة ترقيع الثوب المهلهل .. عليك بشراء ثوب جديد .. (وفر وقتك وفلوسك واحصل على نتيجة أفضل) أقصد من كلامي بدلاً من الخوض في تفاصيل معرفة حل المشكلة وقد يضيع الوقت في محاولة الحل وفي النهاية قد لا تصل لنتيجة مرضية أو يمكن أن تصل لنتيجة ويحدث خطأ في نقطة أخرى المهم موضوعنا عن كيفية إعادة ضبط إعدادات محرر الأكواد .. 1- اقفل برنامج الإكسيل (أو الأوفيس بشكل عام) 2- روح لقايمة Start في الويندوز ثم الأمر Run واكتب الأمر regedit للدخول إلى ريجستري الويندوز 3- روح لهذا المسار HKEY_CURRENT_USER\Software\Microsoft\VBA\6.0\Common\ بالنسبة للرقم 6 قد يكون مختلف حسب نسخة الويندو سواء كانت 32 بت ستجدها رقم 6.0 أما 64 بت فستجدها 7.1 أو 7.0 4- المهم ادخل على المجلد المسمى Common ، اعمل عليه كليك يمين ثم Delete (جمد قلبك ومتخافش .. لو حصل حاجة أنا مش مسئول) هتخرج لك رسالة تأكد الحذف .. انقر نعم يا بطل ومتخافش ..الويندوز هيسقط بس 5- افتح برنامج الإكسيل .. من لوحة المفاتيح اضغط Alt + F11 لتجد نسخة جديدة من محرر الأكواد (محرر الأكواد في ثوبه الجديد) كأنك لسه منصب أوفيس جديد ****************************** يمكنك إعادة ضبط الإعدادات التي تريدها .. الإعدادات التي أقوم بضبطها بشكل شخصي هي كالتالي : ** بعمل Maximize للنافذة اللي قدامي عشان تكون الصورة أوضح ** من Tools ثم Options أعلم علامة صح على الخيار Require Variable Declaration عشان أضيف السطر الخاص بإجبار المبرمج على الإعلان عن المتغيرات .. السطر دا بيكون شكله كالتالي Option Explicit ** من نفس النافذة أشيل علامة الصح من أول خيار Auto syntax Check عشان وأنا بكتب وغلطت متظهرش رسالة تنبيه بالخطأ ( واحد هيقولي طيب دي خاصية مفيدة .. ماشي كويس بس بتعطلني عن كتابة أسطر الكود ..يكفي أنني أرى السطر باللون الأحمر بعد الانتهاء منه .. هذا تنبيه كافي ) ** من نفس النافذة بدخل على التبويب المسمى Editor Format ثم أغير حجم الخط Size عشان أشوف أسطر الكود بشكل واضح ، ثم أوك في النهاية ** على يمين شريط الأدوات بعمل كليك يمين في مكان فارغ وبختار شريط Edit وبسحب الشريط وأضعه جنب شريط الأدوات القياسي (الموجود بالفعل) وفي نهاية المطاف .. أرجو أن يكون الموضوع (رغم بساطته) أن يكون مفيد لمن يريد التعامل مع محرر الأكواد) تقبلوا وافر تقديري وحبي واحترامي

أخي الحبيب وائل الملف الذي رفعته من قبل يبدو أن به مشكلة مع 32 بت .. تم التعديل مرة أخرى على الملف ليعمل بشكل صحيح على 32 بت في الحقيقة أنا لدي جهازين أحدهما بالعمل والآخر بالمنزل ... الجهاز بالعمل يعمل على نظام 64 بت ، وفي المنزل على نظام 32 بت (وأنا متعمد إني أشتغل على النظامين ..) المهم بالنسبة للتعامل مع الكود أنا بجرب أضيف كلمة Ptrsafe في حالة نظام 64 بت وبس بعد كلمة Declare فبشوف الإعلان الموجود وليكن بهذا الشكل Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _ ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Any) As Long عند فتح الملف على نظام 64 بت سيظهر هذا السطر باللون الأحمر مما يدل أن هناك مشكلة في التعامل معه .. فأقوم بإضافة كلمة PtrSafe بعد كلمة Declare .. بهذا الشكل Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" ( _ ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Any) As Long السطر الأخير يعمل على 64 بت فقط ، والأول يعمل على 32 بت فقط ................ للجمع بينهما استخدام الصيغة التالية ليعمل على كلا النظامين معاً #If VBA7 Then #Else #End If ليكون الكود بهذا الشكل في نهاية الأمر #If VBA7 Then Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" ( _ ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Any) As Long #Else Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _ ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Any) As Long #End If وبالتالي يعمل الكود على النظامين معاً .. أرجو أن أكون قد وفقت في توصيل المعلومة ملحوظة : أحياناً لا يكون التعديل في الكلمة Ptrsafe فقط .. الموضوع محتاج دراسة أنا قدمت لك ما أعرفه بخصوص تلك النقطة تحديداً تقبل وافر تقديري واحترامي

أخي الكريم الكود التالي Sub GetId() Dim Cell As Range, Rng As Range 'سطر لتجنب الخطأ في حالة عدم العثور على نتائج On Error Resume Next 'تعيين نطاق البيانات في ورقة البيانات الرئيسية Set Rng = Sheet1.Range("B3:C" & Sheet1.Cells(Rows.Count, 2).End(xlUp).Row) 'عمل حلقة تكرارية لكل خلية من خلايا النطاق المراد إظهار النتائج به ، في العمود الثالث For Each Cell In Sheet2.Range("C4:C" & Sheet2.Cells(Rows.Count, 2).End(xlUp).Row) 'قيمة الخلية تساوي نتيجة البحث عن الخلية المجاورة في نطاق البيانات ، ويكون الحبث في خانة العمود الثاني Cell.Value = Application.WorksheetFunction.VLookup(Cell.Offset(0, -1), Rng, 2, False) Next Cell End Sub الكود مرفق بالشرح .. ما هو التعديل المطلوب .. حاول ترفق ملفك لتكون الأمور أوضح إذا كنت تقصد نطاق البيانات يبقا التعديل أمره بسيط هتشوف صف البداية وليكن كما في الكود الصف الثالث والأعمدة زي ما ذكرت بدايتها العمود C ونهايتها العمود Z إذاً التعديل يكون في سطر تعيين نطاق البيانات بهذا الشكل Set Rng = Sheet1.Range("C3:Z" & Sheet1.Cells(Rows.Count, 3).End(xlUp).Row)

من خلال التبويب Formulas ثم انقر Name Manager هتلاقي النطاقات المسماة شوف الملفين هتلاقي فيه نطاق بنفس الاسم في كلا الملفين

بارك الله فيك أخي الغالي وائل على الهدية الرائعة إليكم إخواني الملف ليعمل على النواتين 32 بت و64 بت .... UserForm Control With Windows APIs Cpearson.rar

أخي الكريم وائل يبدو أن المشكلة أنك تنسخ اسم نطاق من ملف لملف آخر به نفس اسم النطاق .. يمكنك اختيار Yes في حالة أردت استخدام اسم النطاق الموجود في الملف الهدف أما إذا أردت إعادة تسمية النطاق فيمكنك النقر على No لتسمية النطاق باسم جديد غير الاسم الموجود

إخواني الكرام إليكم الملف يعمل على النسختين 32 بت و 64 بت أرجو أن تستفيدوا منه .. تقبلوا وافر تقدير واحترامي Codes Library v1.9.7.rar

أخي الكريم ارفق الملف الذي لا يعمل على نسخة الأوفيس 64 وسأحاول أن أرشدك إلى الحل .. بمثال مرفق

أخي الكريم ياسر العربي أهلاً بك في المنتدى بين إخوانك ونورت المنتدى بهذا الموضوع المتميز لي رجاء : يرجى تغيير اسم الظهور للغة العربية بالنسبة لطلبك .. هذا الموضوع يكثر فيه الحديث ولكن خلاصة القول ..أنك ما دمت نويت التعلم فستظل في رحلة تعلم مستمرة لا تنتهي عند حد معين فعندما التحقت بالمنتدى في بداية معرفتي بالإكسيل .. كنت أجد الأكواد ألغاز صعبة الفهم لدرجة أنني اعتقدت أن من يكتب الكود ليس من البشر وفي الحقيقة أن التدرب والاستمرارية والمتابعة الجيدة والإطلاع على الكتب والمنتديات الأخرى إلى آخر تلك الطرق للتعلم ستوصلك إلى نتيجة مرضية في النهاية لقد تمرست في المجال من سنوات وإلى اليوم أتعلم كل يوم ما هو جديد في هذا العالم .. ولا مانع على الإطلاق الاستفادة من الأكواد التي يقدمها الآخرون ..بالعكس هذا ما يجب عليك الاقتداء به ، اعمل بالحكمة التي تقول : ابدأ من حيث انتهى الآخرون قم بدراسة الأساسيات في هذا العلم أولاً بشكل جيد حتى إذا تمكنت من الأساسيات انتقل للتعامل الفعلي مع الأكواد وبداية كتابة الكود وعند مرحلة التأليف لا تيأس . لا تيأس .. لا تيأس .. فالفشل سيكون قرينك دائماًَ والفشل ليس بعيب إنما هو دافع للتعلم أكثر والمحاولة أكثر واجعل شعارك : حاول وافشل ثم حاول وافشل ثم كرر المحاولة مئات المرات إذا تطلب الأمر وافشل مئات المرات ، ولا تيأس أبداً .. لابد أنك ستصل إلى بغيتك يوماً ما من فترة قمت بعمل دورة للمبتدئين .. قد لا ترقي الدورة إلى مستوى الكتب التي تقدم أو مستوى الدورات التي قدمت وتقدم ، ولكني تعمدت فيها البساطة قدر الإمكان ومحاولة التحبيب لهذا العلم (الذي يراه البعض أمراً صعباً أو مستحيلاً) وإليك رابط الدورة عله يفيدك وإن شاء الله تكون نجماً ساطعاً في سماء الوطن العربي وتقدم ما يفيدك ويفيد الآخرين من هنا رابط الدورة تقبل وافر تقديري واحترامي

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

أخي الغالي م ح م (مختار حسين محمود) تميز بكل جديد كعادتك دائماً والأكثر روعة هو تقديم شرح للكود مما يسهل على الأعضاء التعديل فيه وفهم كيفية عمل الكود والاستفادة منه بارك الله فيك وجزاك الله خير الجزاء

السلام عليكم ورحمة الله وبركاته إخواني الكرام أحياناً يصادفنا أن يكون حجم الملف كبير جداً مقارنةً بالبيانات الموجودة بداخل الملف .. فقررت عمل موضوع مفتوح يقوم الأعضاء باقتراح طرق لتقليل حجم الملف .. وإليكم ملف للأخ سليم حاصبيا في أحد الموضوعات ..حجم الملف أكثر من 5 ميجا العبد الفقير لله لديه كود خطير يساهم في حل المشكلة ولكن لن أقدمه الآن (كنوع من التشويق ) في انتظار مشاركاتكم القيمة والمساهمة في حل مشكلة تقابل الجميع وفقكم الله لما يحب ويرضى Last Price SALIM.rar

الحمد لله الذي بنعمته تتم الصالحات أخي الكريم يرجى تغيير اسم الظهور للغة العربية تقبل تحياتي

أخي الحبيب أبا الحسن والحسين الموضوع الواحد حينما يطول لا تجد إقبال عليه من جميع الأعضاء حيث أنهم يركنون لشخض واحد لتقديم المساعدة ..أما طرح موضوع جديد بالطلب الجديد وليس لنفس الطلب فيعد تنشيط للموضوع بحيث يساهم فيه كل الأعضاء الآخرين فأقترح طرح موضوع جديد بعنوان مثلاً "التعديل على بيانات تم عمل استدعاء لها" على سبيل المثال والطلب هنا مختلف حيث أنه سيتم التعامل مع البيانات التي تمت عملية الاستدعاء لها .. ولا أقصد بطرح موضوع جديد انتظار ردود جميلة أخرى .. ونقطة أخرى في طرح موضوع جديد إثراء للمنتدى وعمليات البحث ، حيث أن كثرة الموضوعات مع الدقة في اختيار عنوان للموضوع تسهل عملية البحث وتفيد الآخرين فيما بعد هذه مجرد وجهات نظر لا أكثر .. وأنا طوع أمركم فيما ترونه أصلح تقبل وافر تقديري واحترامي

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

أخي الكريم عبد الله يرجى تغيير اسم الظهور للغة العربية كما يرجى مستتقبلاً شرح المطلوب في الموضوع نفسه وليس داخل الملف فحسب إليك الكود التالي عله يكون المطلوب Sub TransferData() Dim WS As Worksheet, SH As Worksheet Dim Cel As Range, LR As Long, CounterID As Long Set WS = Sheets("Sheet1"): Set SH = Sheets("Sheet2") Application.ScreenUpdating = False For Each Cel In WS.Range("C2:C" & WS.Cells(Rows.Count, "C").End(xlUp).Row) If Cel.Value = "موافق علية " And Cel.Offset(, 1).Value = "برنامج تدريبي" Then CounterID = Application.WorksheetFunction.CountIf(SH.Range("B4:B" & SH.Cells(Rows.Count, "B").End(xlUp).Row), Cel.Offset(, -1)) If CounterID >= 1 Then MsgBox "هذا الاسم أو رقم الهوية موجود من قبل" & vbCrLf & Cel.Offset(, -2) & vbTab & vbTab & Cel.Offset(, -1), 64: GoTo Skipper Cel.Offset(, -2).Resize(, 2).Copy LR = SH.Cells(Rows.Count, "A").End(xlUp).Row + 1 SH.Range("A" & LR).PasteSpecial xlPasteValues ElseIf Cel.Value = "موافق علية " And Cel.Offset(, 1).Value = "برنامج توظيف" Then CounterID = Application.WorksheetFunction.CountIf(SH.Range("J4:J" & SH.Cells(Rows.Count, "J").End(xlUp).Row), Cel.Offset(, -1)) If CounterID >= 1 Then MsgBox "هذا الاسم أو رقم الهوية موجود من قبل" & vbCrLf & Cel.Offset(, -2) & vbTab & vbTab & Cel.Offset(, -1), 64: GoTo Skipper Cel.Offset(, -2).Resize(, 2).Copy LR = SH.Cells(Rows.Count, "I").End(xlUp).Row + 1 SH.Range("I" & LR).PasteSpecial xlPasteValues End If Skipper: CounterID = 0 Next Cel MsgBox "تمت عملية الترحيل بعون الله", 64 Application.CutCopyMode = False Application.ScreenUpdating = True End Sub تقبل تحياتي Transfer Data To Another Sheet Skipping Duplicates YasserKhalil.rar

جرب هذا التعديل Sub Macro3() Dim AA As Range For Each AA In Range("L10:L" & [L1000].End(xlUp).Row) If AA <> Empty Then AA.Offset(1, -6).Resize(1, 6).Copy Sheets("قوائم").Range("C" & Sheets("قوائم").[C1000].End(xlUp).Row + 1).PasteSpecial xlPasteValues End If Next Application.CutCopyMode = False End Sub

الحمد لله أخي الحبيب وائل أن تم المطلوب على خير بالنسبة لمسألة الاحتراف .. مفكرتش فيها لأن من خرج من داره اتقل مقداره وبعدين أنا مشترك في بعض المنتديات الأجنبية بس مش فعال أوي هناك .. بجيب الخبرات اللي هناك وأنقلها لكم ودا بردو احتراف ..مش كدا ولا ايه

أخي الكريم وائل الأسيوطي (الحمد لله أن تم تغيير اسم الظهور للغة العربية) بدايةً ادخل على Excel Options ثم Advanced أي خيارات متقدمة ثم اذهب للقسم المسمى When Calculating this workbook وأزل علامة الصح من جانب الخيار Update links to other documents تلك كانت الخطوة الأولى قبل إجراء عملية نسخ أوراق العمل حدد ورقة العمل المسماة 1 ثم من لوحة المفاتيح اضغط Ctrl مع الاستمرار وانقر على ورقة العمل المسماة 2 .. حتى يتم نسخ الورقتين معاً .. كليك يمين عليهما ثم الأمر Move or Copy من النافذة التي ستظهر لك علم على الاختيار Create Copy حتى يتم النسخ وليس القص ، ومن القائمة المنسدلة في النافذة اختر المصنف المراد نسخ الأوراق إليه أرجو أن يكون المطلوب إن شاء الله