اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

ياسر العربى

الخبراء
  • Posts

    1,510
  • تاريخ الانضمام

  • Days Won

    34

كل منشورات العضو ياسر العربى

  1. الموضوع بسيط عدل كما بالصورة وخصوصا رؤوس الاعمدة في الشيت الاول والشيت الثاني حتى يكونا متطابقان من حيث رؤوس الاعمدة وفي الخلايا باللون الاخضر في اعلى الشيت نقوم بوضع شرط البحث او عمود البحث الذي نريد البحث فيه ولا يوجد تعديل بالكود في هذه الحالة وشكرا.
  2. تفضلوا مشاركة منى بالاكواد Sub Test() Dim numx As Long, x As Long, z As Long, bb As Byte Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents bb = Range("D1").Value numx = bb numl = Range("F1").Value ReDim y(1 To numl, 1 To 1) For x = 1 To numl If x = numx Then numx = numx + bb: GoTo 86 If x <> numx Then z = z + 1 y(z, 1) = x End If 86 Next If z > 0 Then Cells(1, 1).Resize(z, 1).Value = y() MsgBox "Done..... (-_-)" End Sub نقوم بوضع الرقم المراد تخطيه وتخطى مضاعفاته ونضع اخر رقم بالسلسلة الرقمية ونقوم بتنفيذ الكود تحياتي special_sequence.rar
  3. مشكور اخي الغالي ا زيزو تفضل اخى الكريم احمد If IsNumeric(Range("BY" & x).Value2) Then If Range("BY" & x) <> "" Or Range("BY" & x) <> "" Then Range("CA" & x) = Range("BY" & x).Value + Range("BZ" & x).Value Else Range("CA" & x) = "" End If Else Range("CA" & x) = "" End If 'ضع الكود قبل كلمة next Next ضع هذا الكود كما هو مذكور قبل كلمة next
  4. عليكم السلام مرحب بيك اخي الكريم ابو موسى في منتدى اوفيسنا ياريت ترفق مثال يوضح المطلوب لتتضح الصورة اكثر وحتى يستطيع الاخوة مساعدتك تحياتي
  5. تفضل اخي ناصر لعله المطلوب بطريقة بسيطة إضافة شرط على كود جلب بيانات.rar
  6. مشكور اخي الكريم ناصر على موضوعك هذا والفضل لك ايضا في تعديلك وتشكيلك للكود ليناسب احتياجاتك زادكم الله علما وجزيت خيرا تقبل تحياتي
  7. الله ينور حبيبي ابو يوسف مبتدئ ايه بقى دا ا نت دخلت عالم الدوال المعرفة اهو جزيت خيرا اخي الكريم تقبل تحياتي
  8. Sub Yasser() Range("B3:G3").Copy ورقة2.Range("B" & [A3].Value + 2) End Sub الكود بسيط في حالة نفس ترتيب الحاويات الموجود بالملف اما لو اختلف نعمل كود تاني دا حل الاخ Samo52 وياريت نغير الاسم للغة العربية تحياتي اما اخي medooo1 هشوف حل باذن الله لك حركة حاويات.rar
  9. تفضل اخي الكريم شرح مبسط Sub Test_Yasser_elaraby() 'بداية اول خلية في الخلايا المدمجة Range("C4").Select 'ايقاف تحديث الشاشة حتى لا ترى معالجة الكود وبطئ التنفيذ Application.ScreenUpdating = False 'حلقة تكرارية لحين تحقق شرط وهو ان يكون اخر خلية عند النزول اسفل بزر End 'وتكون الخلية فارغة يخرج الى الرقم 88 خارج الحلقة التكرارية Do 'الغاء دمج اول خلية تم الوقوف عليها Selection.UnMerge 'ومع نفس التحديد يتم عمل ملئ البيانات لنفس البيان بعد الغاء الدمج Selection.FillDown 'ننتقل الى الخلية المدمجة الاخرى Selection.End(xlDown).Select 'اذا كانت الخلية فارغة ينتقل الى 88 If ActiveCell.Value = "" Then GoTo 88 'يتم اعادة الحلقة التكرارية باستمرار طالما ان الخلية ليست فارغة ويظل ينتقل الى اسفل ويكررالكود Loop 'بعد الانتهاء يتم تحديد الخلية A1 88 Range("A1").Select 'اعادة تحديث الشاشة الى الوضع True Application.ScreenUpdating = True MsgBox "تم الغاء الدمج" End Sub
  10. شرح مبسط للكود Sub Test_Yasser() 'متغير واي ونستخدمه في الحلقة التكرارية الاولى ليرمز لرقم الشيت 'متغير اكس وهو خاص بالحلقة التكرارية الثانية ويقوم بعد عدد الاسطر الموجود باه بيانات لمقارنة كل بيان بصفحته 'المتغير اس تي ار متغير من نوع نصى ليشير الى اسم الشيت وهو يساوي العمود الخاص بأسماء الصفحات Dim Y, X, str As String 'هنا المتغير واي يبدأ من 2 الى 4 وهي عدد الصفحات من بعد الاولي حتى الاخيرة For Y = 2 To 4 'هنا يتم المرور على كل الشيتات المحددة في الحلقة بخلاف الشيت الاول ومسح محتوياتهم تمهيدا لجلب المحتوى الجديد Sheets(Y).Range("C6:F" & Sheets(Y).Cells(Rows.Count, 3).End(xlUp).Row).ClearContents Next 'هناحلقة تكرارية تبدأ بأول صف بيانات وهو 6 حتى نهاية البيانات بالصفحة الرئيسية For X = 6 To Cells(Rows.Count, 3).End(xlUp).Row 'المتغيرالخاص بخليه اسم الشيت حتى يتم نسخ البيانات اليه str = Cells(X, 6) 'هنا يتم نسخ كل صف داخل الحلقة التكرارية ووضعه في الشيت المذكور اسمه بجانب البيانات 'بفرض في هذا المثال ان المتغير اكس بيساوي 6 في اول حلقة له يبقي السطر البرمجي يصبح هكذا ' Range("C6:F6").Copy Sheets("الشركة").Range("C" & Sheets("الشركة").Cells(Rows.Count, 3).End(xlUp).Row + 1) Range("C" & X & ":F" & X).Copy Sheets(str).Range("C" & Sheets(str).Cells(Rows.Count, 3).End(xlUp).Row + 1) Next MsgBox "Done........", 64 End Sub
  11. مشكورين اخواني الكرام فعلا انا تعمدت ان اجعله يستقبل البيانات تلو الاخرى ويحتفظ بالقديمة دا في حالة الترحيل المتراكم اما في الحالة التى طلبتوها دا مثال لعدم تكرار البيانات لعله المطلوب تحياتي لكم بيانات الموظفين - Copy.rar
  12. طيب ممكن كل الاحتمالات يعني كام جروب والاحتمالات اللي ممكن تحصل معاهم عشان الصورة توضح اكتر
  13. السلام عليكم اخي الكريم ناصر سعيد الحمد الله نحن في تمام الصحة لكم كل الشكر والتقدير على اهتمامكم انت والاخ الكريم طائع وفقنا الله واياكم ونتمنى عودة جميع الاحبة الى التفاعل داخل هذا المنتدى العظيم مرة اخرى تقبلوا فائق احترامي وتقديري
  14. دا برنامج مخازن بسيط وفيه الصلاحيات تقدر تطبق مثله كلمة المرور 123 الصلاحيات 123 تحياتي برنامج مخازن بسيط.rar
  15. الشكر لكم استاذنا الكريم دغيدي لمروركم الجميل وتفضل هذا الموضوع لفك حماية محرر الاكواد للامتدادات Xlsm AND Xlsb بدون تحويل الملف الى Xls https://www.officena.net/ib/topic/66951-فك-حماية-محرر-الاكواد-xlsm-xlsb-بدون-تحويل-الملفات-ل-xls/ تحياتي
  16. اختى الكريمة هذا الملف لفك حماية محرر الاكواد وحماية الشيتات من داخل المصنف وليس للحماية من الخارج طلبك موجود بعض البرامج بالمنتدى لفك مثل هذه الحماية اذا كانت كلمة المرور قصيره اما لو كانت كبيرة اما ان تاخذ وقت او هتجدي صعوبة في فكها تحياتي
  17. هل نزلت الفيديو الموجود باول الموضوع به الشرح افضل هل قمت بالبحث اكتر من مرة للتأكد من عدم وجود الكلمة مرة اخرى
  18. اتبع الخطوات جيدا وان شاء الله ستجد الحل ان لم تصل الى المطلوب اكتب هنا الخطوات التي قمت بها بالتحديد
  19. الله يكرمك اخي ناصر تحياتي لك وما نحن الا طلاب علم وما زلنا نتعلم من اساتذتنا العظماء داخل المنتدى وخارجه تقبل تحياتي
  20. باذن الله اقوم بعمل امثلة متعددة على الكود من ترحيل وبحث واستدعاء داخل الشيت او داخل فورم بحث اخي الكريم ابراهيم ابو ليله اخي الكريم جلال الجمال تحياتي لكم
×
×
  • اضف...

Important Information