logo

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
michel Sadek ali mohamed ali-- لا تميز خلال هذه الفترة Yasser Elaraby لا تميز خلال هذه الفترة اكسيل اسئله واجابات



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





13-07-2020 08:57 مساءً
الاساتذة مشرفى المنتدى ارجوا المعذرة
انا اكثر من اتعمله بلوك بالمنتدى مع العلم لا اخرج عن الحدود وعمرى ما اقدر
ارجوا المعذرة هل اسئلتى لا يستفيد بها الاعضاء الاجابة يستفيد اكيد
انا حاسة انى بضايق استاذ ياسر مع العلم انا من معجبينه واتابعه من زمن واستفيد من مواضيعه
اتمنى عدم غلق الموضوع هذاااااااا
عموما اتقدم بالمعذرة
هل استطيع ان اسأل مستر salim بصراحة حضرتك رائع والله
الكود الرائع الخاص بالتقرير
انا غيرت لون التاب من 10 الى3 وبذلك اصبح يستدعى التاب الاحمر تمام
وعدلت فى ارقام الاستدعاء الصفوف ليصبح الاستدعاء من الصف الخامس
ولكن لم استطيع تغير الاسماء فى هذا الصف قبل الاخير
واخفاء الصفوف الخالية من البيانات حتى اتمكن من طباعة التقرير
انا عملى كله استخراج تقارير واحتاج الى التعلم وارجوا من ادارة المنتدى عدم غلق الموضوع
مع خالص الشكر من قلبى لمستر سليم ومستر ياسر
 
 
  yara_by_columns.xlsm   تحميل xlsm مرات التحميل :(3)
الحجم :(2828.593) KB





look/images/icons/i1.gif تغير فى كود التقرير لمستر سليم الممتاز
  13-07-2020 09:57 مساءً   [1]
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس :
تاريخ الميلاد : 1-5-1989
الدعوات : 1
قوة السمعة : 6611
الاعجاب : 2
تم التعديل كما تريدين
اختيار اللون يتم من خلال الخلية N1 ولا لزوم للدخول الى الكود لتغيير
اللون
CODE

Option Explicit
Sub get_special_columns()
Dim D As Worksheet
Dim Sh As Worksheet
Dim Ar(), Min_date As Date, Max_date As Date
Dim K%, t%, Arr_sh()
Dim My_ro%, m%, ro%, my_sum#, x%
K = 2
Set D = Sheets("DataReport")
D.Rows.Hidden = False
If D.Range("A3").CurrentRegion.Rows.Count > 1 Then
  D.Range("A3").CurrentRegion.Offset(1). _
  Resize(D.Range("A3").CurrentRegion.Rows.Count - 1).Clear
End If
If Not IsDate(D.Range("J2")) Or _
 Not IsDate(D.Range("K2")) Then Exit Sub
 Min_date = Application.Min(D.Range("J2:K2"))
 Max_date = Application.Max(D.Range("J2:K2"))
  Ar = Array("E", "F", "G", "H", "I", "J")
For Each Sh In Sheets
    If Sh.Tab.ColorIndex = D.Range("N1") Then
      ReDim Preserve Arr_sh(m)
       Arr_sh(m) = Sh.Name: m = m + 1
     End If
Next Sh
 If m = 0 Then Exit Sub
For m = LBound(Arr_sh) To UBound(Arr_sh)
 D.Cells(K, 1) = Arr_sh(m)
 D.Cells(K + 1, 1) = "Total"
 D.Cells(K + 1, 1).Resize(, UBound(Ar) + 2).Interior.ColorIndex = 20
 K = K + 2
Next m

My_ro = 3
For m = LBound(Arr_sh) To UBound(Arr_sh)
  Set Sh = Sheets(Arr_sh(m))
  Sh.Range("A5:J20000").Interior.ColorIndex = xlNone
   ro = Sh.Cells(Rows.Count, 1).End(3).Row
   For K = LBound(Ar) To UBound(Ar)
        t = K + 2
        For x = 4 To ro
            If Sh.Cells(x, 1) <= Max_date _
            And Sh.Cells(x, 1) >= Min_date Then
              If Val(Sh.Cells(x, Ar(K))) <> 0 Then
                Sh.Cells(x, Ar(K)).Interior.ColorIndex = 6
                my_sum = my_sum + Sh.Cells(x, Ar(K))
              End If
            End If
        Next x
        D.Cells(My_ro, t) = my_sum
        my_sum = 0
   Next K
   My_ro = My_ro + 2
Next m
D.Cells(My_ro, 1) = "Sum Of All"
Rem D.Cells(My_ro - 1, 2).Resize(, UBound(Ar) + 1) = Ar
    With D.Cells(My_ro - 1, 2).Resize(, 6)
      .Value = D.Cells(1, 2).Resize(, 6).Value
      .Interior.Color = vbBlue
      .Font.Color = vbWhite
    End With
D.Cells(My_ro, 2).Resize(, UBound(Ar) + 1).Formula = _
"=Sum(B3:B" & My_ro - 2 & ")"
D.Cells(My_ro, 1).Resize(, UBound(Ar) + 2).Interior.ColorIndex = 6

If D.Range("A3").CurrentRegion.Rows.Count > 1 Then
   With D.Range("A3").CurrentRegion.Offset(1). _
     Resize(D.Range("A3").CurrentRegion.Rows.Count - 1)
    .Borders.LineStyle = 1: .Font.Size = 14
    .Font.Bold = True: .HorizontalAlignment = xlCenter
    .Value = .Value
   End With
End If
 For m = My_ro - 2 To 3 Step -1
  If D.Cells(m, 1) = "Total" And Application.Sum(D.Cells(m, 2).Resize(, 6)) = 0 Then
  D.Cells(m, 1).EntireRow.Hidden = True
  End If
 Next
End Sub
'++++++++++++++++++++++++++++++
Sub show_all()
Sheets("DataReport").Rows.Hidden = False
End Sub


الملف مرفق
 
 
  yara_Col.xlsm   تحميل xlsm مرات التحميل :(10)
الحجم :(3230.187) KB


أثارت هذه المشاركة إعجاب: YasserKhalil، yara ahmed، abouelhassan،



look/images/icons/i1.gif تغير فى كود التقرير لمستر سليم الممتاز
  13-07-2020 10:26 مساءً   [2]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10510
الجنس :
تاريخ الميلاد : 1-10-1978
الدعوات : 24
قوة السمعة : 36676
الاعجاب : 161
الاستفادة تكون أكثر إذا كانت المناقشة حول نقطة محددة ويوجد محاولات من السائل ..لكن ما ألاحظه أنكي تريدين حل جاهز بدون السعي لمحاولة التعلم ، وهذا ما يحدث مع جل الأعضاء للأسف الشديد

أثارت هذه المشاركة إعجاب: salim، yara ahmed، abouelhassan،



look/images/icons/i1.gif تغير فى كود التقرير لمستر سليم الممتاز
  13-07-2020 11:00 مساءً   [3]
معلومات الكاتب ▼
تاريخ الإنضمام : 07-07-2020
رقم العضوية : 19921
المشاركات : 24
الجنس :
قوة السمعة : 64
الاعجاب : 0
حضرتك ساحر مستر سليم اقسم بالله انا مش مصدقة
انت جميل جداااا بسم الله ماشاء الله
اشكرك جداااااااا والنبى علمنى ههههههه انت مثلى الاعلى
اشكرك من قلبى مع خالص الامانى الطيبة لحضرتك
انا كل شغلى تقارير انا بشوف حضرتك هيرو ماشاء الله عليك
مستر ياسر انا شديدة الاعجاب بيك كل يوم بشتغل باعمالك فى المنتديات واتعلمت كتير جدااا منك
وعندما ناخذ الكود بنعمل عليه بس طبعا خبراتنا صفر بجانب العمالقة
اشكرك بلاش تعمل لى بلوك ههههههههههه

أثارت هذه المشاركة إعجاب: salim، YasserKhalil،



look/images/icons/i1.gif تغير فى كود التقرير لمستر سليم الممتاز
  13-07-2020 11:27 مساءً   [4]
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس :
تاريخ الميلاد : 1-5-1989
الدعوات : 1
قوة السمعة : 6611
الاعجاب : 2
ممكن الاستعانة بهذا الملف ايضاً (صفحة Sh_all) حيث تظهر الشيتات الحمراء والشيتات الخضراء في نفس الصفحة
 
 
  Yara_salim-Full.xlsm   تحميل xlsm مرات التحميل :(4)
الحجم :(88.589) KB


أثارت هذه المشاركة إعجاب: YasserKhalil، yara ahmed،



look/images/icons/i1.gif تغير فى كود التقرير لمستر سليم الممتاز
  14-07-2020 12:18 صباحاً   [5]
معلومات الكاتب ▼
تاريخ الإنضمام : 07-07-2020
رقم العضوية : 19921
المشاركات : 24
الجنس :
قوة السمعة : 64
الاعجاب : 0
اقسم بالله انا مصدومة حضرتك دكتور اكسيل
روعة جداااااااااااا
بس تقرير red
يحتاج نظرة عطف
لان الصفحات الحمراء تقريرها التقرير الاخير بالمجموع اما الخضراء هى مضبوطة
اما الصفحات الحمراء هذا الكود يعمل تمام
[p]
CODE

Option Explicit

Sub get_special_columns()

Dim D As Worksheet

Dim Sh As Worksheet

Dim Ar(), Min_date As Date, Max_date As Date

Dim K%, t%, Arr_sh()

Dim My_ro%, m%, ro%, my_sum#, x%

K = 2

Set D = Sheets("DataReport")

D.Rows.Hidden = False

If D.Range("A3").CurrentRegion.Rows.Count > 1 Then

  D.Range("A3").CurrentRegion.Offset(1). _

  Resize(D.Range("A3").CurrentRegion.Rows.Count - 1).Clear

End If

If Not IsDate(D.Range("J2")) Or _

 Not IsDate(D.Range("K2")) Then Exit Sub

 Min_date = Application.Min(D.Range("J2:K2"))

 Max_date = Application.Max(D.Range("J2:K2"))

  Ar = Array("E", "F", "G", "H", "I", "J")

For Each Sh In Sheets

    If Sh.Tab.ColorIndex = D.Range("N1") Then

      ReDim Preserve Arr_sh(m)

       Arr_sh(m) = Sh.Name: m = m + 1

     End If

Next Sh

 If m = 0 Then Exit Sub

For m = LBound(Arr_sh) To UBound(Arr_sh)

 D.Cells(K, 1) = Arr_sh(m)

 D.Cells(K + 1, 1) = "Total"

 D.Cells(K + 1, 1).Resize(, UBound(Ar) + 2).Interior.ColorIndex = 20

 K = K + 2

Next m



My_ro = 3

For m = LBound(Arr_sh) To UBound(Arr_sh)

  Set Sh = Sheets(Arr_sh(m))

  Sh.Range("A5:J20000").Interior.ColorIndex = xlNone

   ro = Sh.Cells(Rows.Count, 1).End(3).Row

   For K = LBound(Ar) To UBound(Ar)

        t = K + 2

        For x = 4 To ro

            If Sh.Cells(x, 1) <= Max_date _

            And Sh.Cells(x, 1) >= Min_date Then

              If Val(Sh.Cells(x, Ar(K))) <> 0 Then

                Sh.Cells(x, Ar(K)).Interior.ColorIndex = 6

                my_sum = my_sum + Sh.Cells(x, Ar(K))

              End If

            End If

        Next x

        D.Cells(My_ro, t) = my_sum

        my_sum = 0

   Next K

   My_ro = My_ro + 2

Next m

D.Cells(My_ro, 1) = "Sum Of All"

Rem D.Cells(My_ro - 1, 2).Resize(, UBound(Ar) + 1) = Ar

    With D.Cells(My_ro - 1, 2).Resize(, 6)

      .Value = D.Cells(1, 2).Resize(, 6).Value

      .Interior.Color = vbBlue

      .Font.Color = vbWhite

    End With

D.Cells(My_ro, 2).Resize(, UBound(Ar) + 1).Formula = _

"=Sum(B3:B" & My_ro - 2 & ")"

D.Cells(My_ro, 1).Resize(, UBound(Ar) + 2).Interior.ColorIndex = 6



If D.Range("A3").CurrentRegion.Rows.Count > 1 Then

   With D.Range("A3").CurrentRegion.Offset(1). _

     Resize(D.Range("A3").CurrentRegion.Rows.Count - 1)

    .Borders.LineStyle = 1: .Font.Size = 14

    .Font.Bold = True: .HorizontalAlignment = xlCenter

    .Value = .Value

   End With

End If

 For m = My_ro - 2 To 3 Step -1

  If D.Cells(m, 1) = "Total" And Application.Sum(D.Cells(m, 2).Resize(, 6)) = 0 Then

  D.Cells(m, 1).EntireRow.Hidden = True

  End If

 Next

End Sub

'++++++++++++++++++++++++++++++

Sub show_all()

Sheets("DataReport").Rows.Hidden = False

End Sub



</pre>
نستبدله يا دكتور يا جميل
مع خالص شكرى




look/images/icons/i1.gif تغير فى كود التقرير لمستر سليم الممتاز
  14-07-2020 06:56 صباحاً   [6]
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس :
تاريخ الميلاد : 1-5-1989
الدعوات : 1
قوة السمعة : 6611
الاعجاب : 2
تأكدي من وجود صفجات خضراء (لون الــ Tab أخضر)
لأن عندي الكود يعمل بشكل جيد على اللونين
 
 
  yara_Col_test.xlsm   تحميل xlsm مرات التحميل :(9)
الحجم :(4507.816) KB


أثارت هذه المشاركة إعجاب: YasserKhalil، yara ahmed، abouelhassan،



look/images/icons/i1.gif تغير فى كود التقرير لمستر سليم الممتاز
  14-07-2020 08:34 صباحاً   [7]
معلومات الكاتب ▼
تاريخ الإنضمام : 07-07-2020
رقم العضوية : 19921
المشاركات : 24
الجنس :
قوة السمعة : 64
الاعجاب : 0
كل شكرى وحبى لحضرتك رائع اكثر من رائع
حضرتك مبدع الف شكر لاحرمناك ابدااااااااااااا
تعيش والله حاجة مذهلة
لدى سؤال بس مش هاكتبه هنا احسن يتعملى بلوك هههههههههههههههههه
لدى خمس جداول بهم عدد من الاعمدة والصفوف ليس متساوية
بعض الاسماء فى العمود الاول متشابهة
اقوم بعمل دمج لهذه الجداول الخمسة لاستخراج جدول واحد به مجموع المتشابه
هل يمكن تنفيذ الدمج بواسطة الكود رغم عدم تساوى عدد الاعمدة او الصفوف وليس كل الاسماء فى العمود الاول متشابهة
اذا كانت الاجابة نعم سأقوم بعمل موضوع مستقل واذا كانت لا ساظل بعملية الدمج يدويا
حضرتك جميلللللللللللللللل جداااااااااااااااااااااااااااااااااااا ممتااااااااااااااااااااااااااز دكتورالاكسيل

أثارت هذه المشاركة إعجاب: YasserKhalil،



look/images/icons/i1.gif تغير فى كود التقرير لمستر سليم الممتاز
  14-07-2020 08:50 صباحاً   [8]
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس :
تاريخ الميلاد : 1-5-1989
الدعوات : 1
قوة السمعة : 6611
الاعجاب : 2
جربي هذا في مشاركة مستقلة
الاسماء لا تكون بشكل معقد:
بل تكون بسيطة مثلاً A1,A2... B1 ,B2, B3
و ذلك من اجل المقارنة
ولا تنسي شروط الجداول

أثارت هذه المشاركة إعجاب: abouelhassan، yara ahmed،



look/images/icons/i1.gif تغير فى كود التقرير لمستر سليم الممتاز
  14-07-2020 09:10 صباحاً   [9]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10510
الجنس :
تاريخ الميلاد : 1-10-1978
الدعوات : 24
قوة السمعة : 36676
الاعجاب : 161
يرجى الالتزام بالتعليمات بأن يطرح الموضوع لنقطة واحدة فقط كما يرجى أن ترينا محاولاتك .. فلا أحبذ طرح الموضوع بدون محاولة منك إذ يعتبر هذا سعي للحصول على إجابة جاهزة وفقط بدون سعي للتعلم ، وهذا مبدأ المنتدى وأي مخالفة سيتم حذفها أو إغلاق الموضوع.

أثارت هذه المشاركة إعجاب: abouelhassan، yara ahmed،



look/images/icons/i1.gif تغير فى كود التقرير لمستر سليم الممتاز
  14-07-2020 09:12 صباحاً   [10]
معلومات الكاتب ▼
تاريخ الإنضمام : 26-05-2020
رقم العضوية : 19295
المشاركات : 184
الجنس :
قوة السمعة : 423
الاعجاب : 3
نحتاج دورات استاذنا كما كنت سابقا فيدويهات وشرح
مع الاحترام والتقدير




look/images/icons/i1.gif تغير فى كود التقرير لمستر سليم الممتاز
  14-07-2020 09:13 صباحاً   [11]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10510
الجنس :
تاريخ الميلاد : 1-10-1978
الدعوات : 24
قوة السمعة : 36676
الاعجاب : 161
بارك الله فيك أخي العزيز أبا الحسن
ضيق الوقت وكثرة الانشغال تمنعني للأسف من تقديم المزيد .. بالمنتدى المئات والمئات من الشروحات حاول الاستفادة منها قدر الإمكان وتطوير نفسك

أثارت هذه المشاركة إعجاب: abouelhassan،



look/images/icons/i1.gif تغير فى كود التقرير لمستر سليم الممتاز
  14-07-2020 09:16 صباحاً   [12]
معلومات الكاتب ▼
تاريخ الإنضمام : 26-05-2020
رقم العضوية : 19295
المشاركات : 184
الجنس :
قوة السمعة : 423
الاعجاب : 3
شكر وتقديرى لحضرتك شغال والله ياباشا من اول مدونتك وفيديوهاتك وكل المواضيع السابقة
وحضرتك مميز جداااا فى الشرح وباستطاعتك توصيل المعلومات بيسر لذا نطمع فى المزيد بالمنتدى الجميل ده
وتكون حصرى
احترامى

أثارت هذه المشاركة إعجاب: YasserKhalil،



اضافة رد جديد اضافة موضوع جديد




الكلمات الدلالية
التقرير ، تغير ، لمستر ، سليم ، الممتاز ،









اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 01:26 PM