سليم حاصبيا
أوفيسنا-
Posts
8,723 -
تاريخ الانضمام
-
Days Won
262
نوع المحتوي
المنتدى
مكتبة الموقع
معرض الصور
المدونات
الوسائط المتعددة
كل منشورات العضو سليم حاصبيا
-
جرب هذا الملف Sum_list.xlsx
-
كود استدعاء البيانات الى صفحة الضبط بتاريح من وتاريخ حتى
سليم حاصبيا replied to omhamzh's topic in منتدى الاكسيل Excel
تم التعديل على الملف بواسطة معادلة في العامود الأول بمجرد تغيير اي اسم في الشيت Minho فقط يتم التغيير في كل النطاقات و تتسري المعادلات الباقية كما تريدين الصورة المرفقة توضح ذلك أكرر التغيير في Minho فقط الملف مرفق للتجربة With_formula_New1.xlsm -
كود استدعاء البيانات الى صفحة الضبط بتاريح من وتاريخ حتى
سليم حاصبيا replied to omhamzh's topic in منتدى الاكسيل Excel
ارفعي ملف فيه القليل من البيانات (و إن كانت عشوائية) صفين لا تكفي لمعاينة عمل معادلة (10 صفوف اقل شيء) المعادلات في الملف الذي رفعته لك سابقاً محمية لعدم العيث بها عن طريق الخطأ - لذلك لا تستطعين التعديل عليها بينما في اي خلية اخرى يمنكنك عمل اي شيء تم النعديل على الأسماء المعادلات تعمل بشكل ممتاز في الملف الجدبد المرفق من قبلي (حسب الصورة) مرفق ملف جديد للتوضيح With_formula_New.xlsm -
جرب هذا الملف (من الارشيف القديم) يمكنك اضافة قدر ما تشاء من البيانات Working time.xlsx
-
كود استدعاء البيانات الى صفحة الضبط بتاريح من وتاريخ حتى
سليم حاصبيا replied to omhamzh's topic in منتدى الاكسيل Excel
ضعي مكان 1 2 3 4.... الأسماء الجديدة للأعمدة (بالضبط دون مسافات زائدة او ناقصة أو تغيير بالخط Capital & Small) -
تم حل المشكلة dATA_Ameel _(1).xlsm
-
كود استدعاء البيانات الى صفحة الضبط بتاريح من وتاريخ حتى
سليم حاصبيا replied to omhamzh's topic in منتدى الاكسيل Excel
أولاً لم أر أي اعجاب لأي رد على موضوعاتك فهل النقر بزر الماوس على اعجاب شيء يأخذ وقتاً ثانيا أنا لا اتعامل مع اليوزرفورم (خبرتي متواضعة بهذا الشأن) ثالثاً يرجى ادراج المشاركة الأخيرة في موضوع مستقل لعل احدهم(من له الخبرة الواسعة في اليوزر) يريد ان يشارك في الأجابة -
كود استدعاء البيانات الى صفحة الضبط بتاريح من وتاريخ حتى
سليم حاصبيا replied to omhamzh's topic in منتدى الاكسيل Excel
لا تكتبي مجموع بل Sum او اي شيء احر باللغة الاجنبية Summation مثلاً على كل حال كتابة اي شيء لا يكون تاريخاً يتم تجاهله -
كود استدعاء البيانات الى صفحة الضبط بتاريح من وتاريخ حتى
سليم حاصبيا replied to omhamzh's topic in منتدى الاكسيل Excel
لا أرى اي كلمة محموع في minho و لا في laho -
تم معالحة الأمر dATA_Ameel _Updated.xlsm
-
كود استدعاء البيانات الى صفحة الضبط بتاريح من وتاريخ حتى
سليم حاصبيا replied to omhamzh's topic in منتدى الاكسيل Excel
للمرة الالف ( عدم تسمية الأوراق باللغة العربية) صجيج ان لغتنتا هي لغة القرآن الكريم ولغة الضاد ومن أجمل لغات العالم ونحن نفتخر فيها لكن للأسف لا تصلخ 100% للمعادلات والأكواد في اكسل (نسبة الخطأ تتعدى ال 90%) جربي كتابة اسم اي ورقة باللغة العربية وانظري مذا يجري تم حل الموضوع بالمعادلات (المعادلات محمية / ضد الكتابة فوقها / لعدم العيث بها عن طريق الخطا زلكنها ليست محمية ضد الحذف) المعادلة في الخلية C3 مع (Ctl+Shift+Enter) والسحب نزولاُ حتى الخلية C25 و لذلك الأمر بالنسبة للخلية D3 مع تغيير اسم الصفحة داخل المعادلة =SUM((Minho!$A$2:$A$1000>=$E$2)*(Minho!$A$2:$A$1000<=$F$2)*(INDIRECT("Minho!"&ADDRESS(2,(MATCH($A3,Minho!$A$1:$AA$1)),1)&":"&ADDRESS(1000,(MATCH($A3,Minho!$A$1:$AA$1)),1)))) With_formula.xlsm -
كود استدعاء البيانات الى صفحة الضبط بتاريح من وتاريخ حتى
سليم حاصبيا replied to omhamzh's topic in منتدى الاكسيل Excel
تم التعديل (بالمعادلات صعبة قوي) From_To Rows_Columns_Adv.xlsm -
كود استدعاء البيانات الى صفحة الضبط بتاريح من وتاريخ حتى
سليم حاصبيا replied to omhamzh's topic in منتدى الاكسيل Excel
ممكن تلافي مشكلة الأعمدة بأدراج الأرقام غلى شكل X/y حيث تدل X على الصفحة "Minho" و y تدل على الصفخة "Laho" و في حال كان الرقم منفرداً يكون في الصفحة "Minho" تعديل الكود Option Explicit Sub Extact_Data_By_Columns() Rem Created By Salim Hasbaya on 29/5/2020 Application.ScreenUpdating = False Dim M As Worksheet, L As Worksheet, R As Worksheet Dim Rg_M As Range, Rg_L As Range Dim I%, Lr_M%, Lr_L%, RO%, it Dim St_Date As Date, End_Date As Date Dim arr, My_sum#, My_count% Set M = Sheets("Minho"): Set L = Sheets("Laho") Set R = Sheets("Repport") Lr_M = M.Cells(Rows.Count, 1).End(3).Row Lr_L = L.Cells(Rows.Count, 1).End(3).Row R.Range("A2").Resize(26, 3).ClearContents If Not IsDate(R.Range("D2")) Or Not IsDate(R.Range("D2")) Then _ MsgBox "Type Please Correct Dates In The Cells D2 and E2 ": GoTo Leave_Me_Olone St_Date = Application.Min(R.Range("D2:E2")) End_Date = Application.Max(R.Range("D2:E2")) ReDim arr(1 To 26) For I = 1 To 26 arr(I) = I Next '++++++++++++++++++++++++++++++++++++++++ With M .Range("A2:AC" & Lr_M).Interior.ColorIndex = xlNone For I = 2 To Lr_M If .Cells(I, 1) <= End_Date _ And .Cells(I, 1) >= St_Date Then .Cells(I, 1).Resize(, 29).Interior.ColorIndex = 6 End If Next I End With ''++++++++++++++++++++++++++++++++ With L .Range("A2:AC" & Lr_L).Interior.ColorIndex = xlNone For I = 2 To Lr_L If .Cells(I, 1) <= End_Date _ And .Cells(I, 1) >= St_Date Then .Cells(I, 1).Resize(, 29).Interior.ColorIndex = 6 End If Next I End With RO = 2 '++++++++++++++++++++++++++++++++++++++++ With M For Each it In arr My_count = Application.CountA(.Cells(2, it + 3).Resize(Lr_M - 1)) If My_count = 0 Then GoTo NexT_it For I = 2 To Lr_M If .Cells(I, it + 3).Interior.ColorIndex = 6 Then My_sum = My_sum + _ IIf(IsNumeric(.Cells(I, it + 3)), .Cells(I, it + 3), 0) If .Cells(I, it + 3) <> vbNullString Then .Cells(I, it + 3).Interior.ColorIndex = 35 End If End If Next I R.Cells(RO, 1) = it: R.Cells(RO, 2) = _ IIf(My_sum <> 0, My_sum, vbNullString) My_sum = 0: RO = RO + 1 NexT_it: Next it End With '++++++++++++++++++++++++++++++++++++ RO = 2: My_sum = 0 With L For Each it In arr My_count = Application.CountA(.Cells(2, it + 3).Resize(Lr_L - 1)) If My_count = 0 Then GoTo NexT_itm For I = 2 To Lr_L If .Cells(I, it + 3).Interior.ColorIndex = 6 Then My_sum = My_sum + _ IIf(IsNumeric(.Cells(I, it + 3)), .Cells(I, it + 3), 0) If .Cells(I, it + 3) <> vbNullString Then .Cells(I, it + 3).Interior.ColorIndex = 35 End If End If Next I R.Cells(RO, 1) = _ IIf(R.Cells(RO, 1) = vbNullString, it, it & " \ " & R.Cells(RO, 1)) R.Cells(RO, 3) = _ IIf(My_sum <> 0, My_sum, vbNullString) My_sum = 0: RO = RO + 1 NexT_itm: Next it End With '++++++++++++++++++++++++++++++++++++ Leave_Me_Olone: Application.ScreenUpdating = True End Sub -
كود استدعاء البيانات الى صفحة الضبط بتاريح من وتاريخ حتى
سليم حاصبيا replied to omhamzh's topic in منتدى الاكسيل Excel
تم التعديل ملاحظة (أرقام الأعمدة يمكن ان لا تتطابق في صفخات Minho & Laha )لذلك يجب ادراج عامود اضافي لهذه الأرقام في صفحة Repport ) لا وقت لدي لعمل ذلك (تركت أرقام الأعمدة للصفخة Minho) Option Explicit Sub Extact_Data_By_Columns() Rem Created By Salim Hasbaya on 29/5/2020 Application.ScreenUpdating = False Dim M As Worksheet, L As Worksheet, R As Worksheet Dim Rg_M As Range, Rg_L As Range Dim I%, Lr_M%, Lr_L%, RO%, it Dim St_Date As Date, End_Date As Date Dim arr, My_sum#, My_count% Set M = Sheets("Minho"): Set L = Sheets("Laho") Set R = Sheets("Repport") Lr_M = M.Cells(Rows.Count, 1).End(3).Row Lr_L = L.Cells(Rows.Count, 1).End(3).Row R.Range("A2").Resize(26, 3).ClearContents If Not IsDate(R.Range("D2")) Or Not IsDate(R.Range("D2")) Then _ MsgBox "Type Please Correct Dates In The Cells D2 and E2 ": GoTo Leave_Me_Olone St_Date = Application.Min(R.Range("D2:E2")) End_Date = Application.Max(R.Range("D2:E2")) ReDim arr(1 To 26) For I = 1 To 26 arr(I) = I Next '++++++++++++++++++++++++++++++++++++++++ With M .Range("A2:AC" & Lr_M).Interior.ColorIndex = xlNone For I = 2 To Lr_M If .Cells(I, 1) <= End_Date _ And .Cells(I, 1) >= St_Date Then .Cells(I, 1).Resize(, 29).Interior.ColorIndex = 6 End If Next I End With ''++++++++++++++++++++++++++++++++ With L .Range("A2:AC" & Lr_L).Interior.ColorIndex = xlNone For I = 2 To Lr_L If .Cells(I, 1) <= End_Date _ And .Cells(I, 1) >= St_Date Then .Cells(I, 1).Resize(, 29).Interior.ColorIndex = 6 End If Next I End With RO = 2 '++++++++++++++++++++++++++++++++++++++++ With M For Each it In arr My_count = Application.CountA(.Cells(2, it + 3).Resize(Lr_M - 1)) If My_count = 0 Then GoTo NexT_it For I = 2 To Lr_M If .Cells(I, it + 3).Interior.ColorIndex = 6 Then My_sum = My_sum + _ IIf(IsNumeric(.Cells(I, it + 3)), .Cells(I, it + 3), 0) If .Cells(I, it + 3) <> vbNullString Then .Cells(I, it + 3).Interior.ColorIndex = 35 End If End If Next I R.Cells(RO, 1) = it: R.Cells(RO, 2) = IIf(My_sum <> 0, My_sum, vbNullString) My_sum = 0: RO = RO + 1 NexT_it: Next it End With '++++++++++++++++++++++++++++++++++++ RO = 2: My_sum = 0 With L For Each it In arr My_count = Application.CountA(.Cells(2, it + 3).Resize(Lr_L - 1)) If My_count = 0 Then GoTo NexT_itm For I = 2 To Lr_L If .Cells(I, it + 3).Interior.ColorIndex = 6 Then My_sum = My_sum + _ IIf(IsNumeric(.Cells(I, it + 3)), .Cells(I, it + 3), 0) If .Cells(I, it + 3) <> vbNullString Then .Cells(I, it + 3).Interior.ColorIndex = 35 End If End If Next I R.Cells(RO, 3) = IIf(My_sum <> 0, My_sum, vbNullString) My_sum = 0: RO = RO + 1 NexT_itm: Next it End With '++++++++++++++++++++++++++++++++++++ Leave_Me_Olone: Application.ScreenUpdating = True End Sub الملف( للمرة الثّالثة) From_To Row_Column_1.xlsm -
كود استدعاء البيانات الى صفحة الضبط بتاريح من وتاريخ حتى
سليم حاصبيا replied to omhamzh's topic in منتدى الاكسيل Excel
كان من الواجب التوضيح في بادىء الأمر لعدم تضييع الوقت بأمور فائدة منها الكود الجديد Option Explicit Sub Extarct_Data_By_Columns() Rem Created By Salim Hasbaya on 29/5/2020 Dim M As Worksheet, L As Worksheet, R As Worksheet Dim Rg_M As Range, Rg_L As Range Dim I%, Lr_M%, Lr_L%, RO%, it Dim St_Date As Date, End_Date As Date Dim arr, My_sum# Set M = Sheets("Minho"): Set L = Sheets("Laho") Set R = Sheets("Repport") Lr_M = M.Cells(Rows.Count, 1).End(3).Row Lr_L = L.Cells(Rows.Count, 1).End(3).Row R.Range("B2").Resize(25, 2).ClearContents If Not IsDate(R.Range("D2")) Or Not IsDate(R.Range("D2")) Then _ MsgBox "Type Please Correct Dates In The Cells D2 and E2 ": Exit Sub St_Date = Application.Min(R.Range("D2:E2")) End_Date = Application.Max(R.Range("D2:E2")) ReDim arr(1 To 25) For I = 1 To 25 arr(I) = I + 3 Next '++++++++++++++++++++++++++++++++++++++++ With M .Range("A2:AC" & Lr_M).Interior.ColorIndex = xlNone For I = 2 To Lr_M If .Cells(I, 1) <= End_Date _ And .Cells(I, 1) >= St_Date Then .Cells(I, 1).Resize(, 29).Interior.ColorIndex = 6 End If Next I End With ''++++++++++++++++++++++++++++++++ With L .Range("A2:AC" & Lr_L).Interior.ColorIndex = xlNone For I = 2 To Lr_L If .Cells(I, 1) <= End_Date _ And .Cells(I, 1) >= St_Date Then .Cells(I, 1).Resize(, 29).Interior.ColorIndex = 6 End If Next I End With RO = 2 With M For Each it In arr For I = 2 To Lr_M If .Cells(I, it).Interior.ColorIndex = 6 Then My_sum = My_sum + _ IIf(IsNumeric(.Cells(I, it)), .Cells(I, it), 0) End If Next I R.Cells(RO, 2) = IIf(My_sum > 0, My_sum, vbNullString) My_sum = 0: RO = RO + 1 Next it End With '++++++++++++++++++++++++++++++++++++ RO = 2: My_sum = 0 With L For Each it In arr For I = 2 To Lr_M If .Cells(I, it).Interior.ColorIndex = 6 Then My_sum = My_sum + _ IIf(IsNumeric(.Cells(I, it)), .Cells(I, it), 0) End If Next R.Cells(RO, 3) = IIf(My_sum > 0, My_sum, vbNullString) My_sum = 0: RO = RO + 1 Next End With '++++++++++++++++++++++++++++++++++++ End Sub المرفق من جديد (الماكرو الاول ما زال يعمل اذا لزم الأمر باستعماله) From_To Row_Col.xlsm -
كود استدعاء البيانات الى صفحة الضبط بتاريح من وتاريخ حتى
سليم حاصبيا replied to omhamzh's topic in منتدى الاكسيل Excel
هذا الكود يقوم بما يلزم تغيير اسماء الصفحات الى اللغة الأجنبية لحسن نسخ الكود ولصقه Option Explicit Sub Extarct_Data() Rem Created By Salim Hasbaya on 29/5/2020 Dim M As Worksheet, L As Worksheet, R As Worksheet Dim Rg_M As Range, Rg_L As Range Dim I%, Lr_M%, Lr_L%, RO% Dim St_Date As Date, End_Date As Date Set M = Sheets("Minho"): Set L = Sheets("Laho") Set R = Sheets("Repport") Lr_M = M.Cells(Rows.Count, 1).End(3).Row Lr_L = L.Cells(Rows.Count, 1).End(3).Row R.Range("B2").Resize(25, 2).ClearContents If Not IsDate(R.Range("D2")) Or Not IsDate(R.Range("D2")) Then _ MsgBox "Type Please Correct Dates In The Cells D2 and E2 ": Exit Sub St_Date = Application.Min(R.Range("D2:E2")) End_Date = Application.Max(R.Range("D2:E2")) '++++++++++++++++++++++++++++++++++++++++ With M .Range("A2:AC" & Lr_M).Interior.ColorIndex = xlNone RO = 2 For I = 2 To Lr_M If .Cells(I, 1) <= End_Date _ And .Cells(I, 1) >= St_Date Then .Cells(I, 1).Resize(, 29).Interior.ColorIndex = 6 R.Cells(RO, 2) = Application.Sum(.Cells(I, 4).Resize(, 26)) RO = RO + 1 End If Next I End With '++++++++++++++++++++++++++++++++ With L .Range("A2:AC" & Lr_L).Interior.ColorIndex = xlNone RO = 2 For I = 2 To Lr_L If .Cells(I, 1) <= End_Date _ And .Cells(I, 1) >= St_Date Then .Cells(I, 1).Resize(, 29).Interior.ColorIndex = 6 R.Cells(RO, 3) = Application.Sum(.Cells(I, 4).Resize(, 26)) RO = RO + 1 End If Next I End With End Sub الملف مرفق From_To.xlsm -
كود استدعاء البيانات الى صفحة الضبط بتاريح من وتاريخ حتى
سليم حاصبيا replied to omhamzh's topic in منتدى الاكسيل Excel
جرب هذا الملف MENhOLAHO.xlsm -
معك كل الحق أعتذر انا صراحة لم أجربها
-
تفضل لكن في مشاركة مستقلة
-
ممتازة منك صديقي رائد (لكنها تدرج المكرر في حال وجوده) هذه معادلة احرى (بردو تدرج المكرر في حال وجوده) (سبق وان قلت ان استعمال الدالة IFERROR ) يفضل عدم استعمالها =IF(ROWS($A$1:A1)>SUMPRODUCT(--(YEAR($B$2:$B$50)=$G$1)),"",INDEX($A$2:$A$50,SMALL(IF($A$2:$A$50<>"",IF(YEAR($B$2:$B$50)=$G$1,ROW($A$2:$A$50)-ROW($A$2)+1)),ROWS($A$1:A1)))) اذا لم نتعمل معك استبدل الفاصلة "," بفاصلة منقوطة ";" مع (Ctrl+Shift+Enter) Prof_names.xlsm
-
جرب هذا الكود Option Explicit Sub get_Prof_names() Dim sh As Worksheet, Rg As Range Dim i%, Yer% Dim Salim As Object Set Salim = CreateObject("Scripting.Dictionary") Set sh = Sheets("sheet1") Set Rg = sh.Range("G3").CurrentRegion If Rg.Rows.Count > 1 Then _ Rg.Offset(1).Resize(Rg.Rows.Count - 1).Clear Yer = sh.Range("G1"): i = 2 Do Until sh.Cells(i, 1) = vbNullString If Year(Cells(i, 2)) = Yer Then Salim(Cells(i, 1).Value) = vbNullString End If i = i + 1 Loop If Salim.Count Then With sh.Range("G4").Resize(Salim.Count) .Value = Application.Transpose(Salim.Keys) .Borders.LineStyle = 1 .Font.Bold = True: .Font.Size = 16 .InsertIndent 1: .Interior.ColorIndex = 35 End With End If End Sub الملف مرفق Prof_names.xlsm
-
جرب هذا الملف تم حماية الصفحة لعدم العيث بالمعادلات عن طريق الخطا (بدون باسورد) dATA_Ameel.xlsm
-
جرب هذا الملف Tajribi_2.xlsm
-
تم انشاء ملف ل خر لمعالجة التاريخ Number_search_date.xlsm
-
جرب هذا الملف العامود L اتركه فارغاً تماماً (حتى لا يؤثر على عمل الماكرو) MY_librery.xlsb لتعديل البيانات يمكنك راٍساُ تعديلها يدوياً ( بعد اجراء الفلتر) أو بواسطة ماكرو اخر