أكاديمية الصقر للتدريب

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


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





تعديل كود اضافة صف للإجمالى مرتين خلال نفس الشهر-للأستاذ ســلــيم حــاصــبيا

السلام عليكم احبائى الكرام بارك الله فيك استاذ سليم وفى جهودكم العظيمة ودائما وابداً محاولاتك الممتازة فى مساعدة كل من ي ..


موضوع مغلق


22-09-2020 11:43 صباحا
هانى على
عضو ماسي
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 10-03-2018
رقم العضوية : 4794
المشاركات : 476
الجنس : ذكر
تاريخ الميلاد : 1-4-1980
يتابعهم : 5
يتابعونه : 4
قوة السمعة : 855
عدد الإجابات: 8
 offline 

السلام عليكم احبائى الكرام
بارك الله فيك استاذ سليم وفى جهودكم العظيمة ودائما وابداً محاولاتك الممتازة فى مساعدة كل من يحتاج الى المساعدة .... ما اقصده  كلما انتهى نصف شهر معين وبدأ بعده تشغيلات شهر جديد او النصف الأخر من نفس الشهر فلابد من وضع صف ايضاً للإجمالى .. وهذا ما توضحه الصورة أكثر .... فأريد ايضاً عند الضغط لتنفيذ الكود يتم وضع كل صفوف الإجمالى المطلوبة اى الصفوف الملونة باللون الأزرق لأن الكود لا ينفذ على هذه الأوضاع , حتى وان لم تنتهى تشغيلات النصف الأول يوم 15 من الشهر او حتى لم تنتهى التشغيلات عند اخر يوم بالشهر سواء كان 28 , 29 ,30,31
Option Explicit
'+++++++++++++++++++++++++++++++++
Dim sh As Worksheet
Dim Max_ro%, New_ro%, I%, Mth, E_Mth
Dim rg As Range, del_rg As Range
Dim Last_date
Dim my_day
Const TOT = "TOTAL"
Const dy = 15
'"""""""""""""""""""""""""""""""""""""
Sub get_total()
Set sh = ActiveSheet
Max_ro = sh.Cells(Rows.Count, 1).End(3).Row
 sh.Range("A4:Q" & Max_ro).Interior.ColorIndex = xlNone
 For I = Max_ro To 4 Step -1
  If Not IsDate(sh.Cells(I, 1)) Then
   sh.Cells(I, 1).EntireRow.Delete
  End If
 Next
End Sub
'+++++++++++++++++++++++++++
Sub Sort_data()
get_total
New_ro = sh.Cells(Rows.Count, 1).End(3).Row
 sh.Range("A3:T" & New_ro).Sort key1:=sh.Range("A3"), Header:=xlYes
End Sub
'+++++++++++++++++++++++++++
Sub Insert_rows()
Set sh = ActiveSheet
'//////////////////////////////////
If sh.Range("A3") = "Date" _
 And sh.Range("B3") = "Hurghada" _
 And sh.Range("A2") = "" Then
 Else
  MsgBox "YOU HAVE DIFFERENT STRUCTURE OF SHEET" & Chr(10) & _
  "MAKE THE SAME STRUCTURE OF THE SHEET :" & """ Limousin Agent"""
  Exit Sub
 End If
'//////////////////////////////
Dim x As Boolean, y As Boolean, z As Boolean
Dim t%, k, A

 Sort_data
 If sh.AutoFilterMode Then
   sh.Range("a4").AutoFilter
  End If
 
 New_ro = sh.Cells(Rows.Count, 1).End(3).Row
 t = 4
 For I = 4 To New_ro + 1000
   If sh.Cells(I, 1) = vbNullString Then Exit For
  If IsDate(sh.Cells(I, 1)) Then
   Mth = Month(sh.Cells(I, 1))
   Last_date = DateSerial(Year(sh.Cells(I, 1)), Mth + 1, 0)
   E_Mth = Month(Last_date)
   my_day = Day(Last_date)
    x = Mth = E_Mth
    y = Day(sh.Cells(I, 1)) = dy Or Day(sh.Cells(I, 1)) = my_day
    z = sh.Cells(I, 1) <> sh.Cells(I + 1, 1)
    If x * y * z = -1 Then
'    sh.Cells(I + 1, 1).Select
    sh.Cells(I + 1, 1).EntireRow.Insert , xlDown
    sh.Cells(I + 1, 1) = TOT
    sh.Cells(I + 1, 1).Resize(, 17).Interior.ColorIndex = 6
    sh.Cells(I + 1, 2).Resize(, 16).Formula = _
    "=SUM(B" & t & ":B" & I & ")"
    t = I + 2: I = I + 1: k = k + 1: New_ro = New_ro + 1

    End If  'x * y * z
     
  End If 'isdate
  Next
 
 New_ro = sh.Cells(Rows.Count, 1).End(3).Row + 1
  sh.Cells(New_ro, 1) = TOT
  sh.Cells(New_ro, 1).Resize(, 17).Interior.ColorIndex = 6
  sh.Cells(New_ro, 2).Resize(, 16).Formula = _
    "=SUM(B" & t & ":B" & New_ro - 1 & ")"
   sh.Range("A4:Q" & New_ro).Value = _
   sh.Range("A4:Q" & New_ro).Value
    clear_last
  '++++++++++++++++++++++++++++++++
   Dim tt%
  tt = Application.CountA(ActiveSheet.Range("a4:a500")) + 3
  If ActiveSheet.Cells(tt, 1) = TOT And _
  Application.Sum(ActiveSheet.Cells(tt, 2).Resize(, 16)) = 0 Then
  ActiveSheet.Cells(tt, 2).EntireRow.Delete
  End If
   A = Application.CountIf(sh.Range("A:A"), TOT)
   MsgBox "I Enter " & A & " " & _
   IIf(A = 1, TOT, "Recordes") & " For you " & Chr(10) & _
   " I hope you say thank you : " & """SALIM"""
 
End Sub
'+++++++++++++++++++++++++++++++++++
Sub clear_last()
Dim m%, Ro%, XX%, d1, d2, kk%, cnt%
 Dim dat1, m1
 Set sh = ActiveSheet
 m = sh.Cells(Rows.Count, 1).End(3).Row - 1
 For XX = 4 To m
 If sh.Cells(XX, 1) = TOT Then
  Ro = sh.Cells(XX, 1).Row
 End If
  Next
  For kk = Ro + 1 To m
 
   m1 = Month(sh.Cells(kk, 1))
   d1 = Day(sh.Cells(kk, 1))
   d2 = Day(DateSerial(Year(sh.Cells(kk, 1)), m1 + 1, 0))
   If d1 <> dy Or d1 <> d2 Then
     cnt = cnt + 1
   End If
   
  Next
  If cnt > 0 Then Cells(m + 1, 1).EntireRow.Delete
End Sub

'++++++++++++++++++++++++++++++++++++++
Sub CLEAR_TOTALS()
Dim k%, B%
Set sh = ActiveSheet
B = Application.CountIf(sh.Range("A:A"), TOT)
Max_ro = sh.Cells(Rows.Count, 1).End(3).Row
 sh.Range("A4:Q" & Max_ro).Interior.ColorIndex = xlNone
 For I = Max_ro To 4 Step -1
  If Not IsDate(sh.Cells(I, 1)) Then
 sh.Cells(I, 1).EntireRow.Delete
   k = k + 1
  End If
 Next
 
  MsgBox "I Clear " & B & " " & _
   IIf(B = 1, TOT, "Recordes") & " For you " & Chr(10) & _
   " I hope you say thank you : " & """SALIM"""
End Sub


fJqdI_1
لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب

 
 
 
  Ali_hani_New.xlsm   تحميل xlsm مرات التحميل :(3)
الحجم :(1513.733) KB



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




03-10-2020 10:22 صباحا
مشاهدة مشاركة منفردة [1]
hassona229
مشرف عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2018
رقم العضوية : 9257
المشاركات : 798
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 13-9-1980
يتابعهم : 0
يتابعونه : 10
قوة السمعة : 4030
عدد الإجابات: 110
 offline 
look/images/icons/i1.gif تعديل كود اضافة صف للإجمالى مرتين خلال نفس الشهر-للأستاذ ســلــيم حــاصــبيا
وعليكم السلام ورحمه الله وبركاته
تفضل اخى الكريم تم حل المشكلة بفضل الله

لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب
 
 
  Ali_hani_New.xlsb   تحميل xlsb مرات التحميل :(2)
الحجم :(161.966) KB


03-10-2020 02:51 مساء
مشاهدة مشاركة منفردة [2]
هانى على
عضو ماسي
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 10-03-2018
رقم العضوية : 4794
المشاركات : 476
الجنس : ذكر
تاريخ الميلاد : 1-4-1980
يتابعهم : 5
يتابعونه : 4
قوة السمعة : 855
عدد الإجابات: 8
 offline 
look/images/icons/i1.gif تعديل كود اضافة صف للإجمالى مرتين خلال نفس الشهر-للأستاذ ســلــيم حــاصــبيا
أحسنت أستاذ حسونة عمل ممتاز بارك الله فيك وزادك الله من فضله ووسع الله فى رزقك وأكرمك الله فى الدارين وجعل الله هذا العمل فى ميزان حسناتك وفرج الله عنك كربات يوم القيامة كما أكرمك وفرجت عنا هذه الكربة
ولكنى اعتذر من حضرتك للتعب -فما هو السبب فى الخلل الحاصل بعد تطبيق الكود خصوصا فى شهر 9 وكما بالصورة فكان يجب ادخال صف أصفر للإجمالى بعد يوم 12/09 وادخال صف أخر بعد يوم  30/09/202........ولكنه كما ترى اكتفى بصف واحد اخر الشهر اى بعد يوم 30/09/2020
ولكم منى جزيل الشكر وبارك الله فيك
NvfS9_1
لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب
 
 
 
  Ali_hani_New.xlsb   تحميل xlsb مرات التحميل :(3)
الحجم :(165.215) KB


03-10-2020 05:09 مساء
مشاهدة مشاركة منفردة [3]
hassona229
مشرف عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2018
رقم العضوية : 9257
المشاركات : 798
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 13-9-1980
يتابعهم : 0
يتابعونه : 10
قوة السمعة : 4030
عدد الإجابات: 110
 offline 
look/images/icons/i1.gif تعديل كود اضافة صف للإجمالى مرتين خلال نفس الشهر-للأستاذ ســلــيم حــاصــبيا
وعليكم السلام ورحمه الله وبركاته
تفضل اخى الكريم تم حل المشكلة بفضل الله
لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب
 
 
  Ali_hani_New.xlsb   تحميل xlsb مرات التحميل :(4)
الحجم :(48.625) KB


03-10-2020 05:15 مساء
مشاهدة مشاركة منفردة [4]
هانى على
عضو ماسي
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 10-03-2018
رقم العضوية : 4794
المشاركات : 476
الجنس : ذكر
تاريخ الميلاد : 1-4-1980
يتابعهم : 5
يتابعونه : 4
قوة السمعة : 855
عدد الإجابات: 8
 offline 
look/images/icons/i1.gif تعديل كود اضافة صف للإجمالى مرتين خلال نفس الشهر-للأستاذ ســلــيم حــاصــبيا
أحسنت أستاذ حسونة عمل ممتاز بارك الله فيك وزادك الله من فضله ووسع الله فى رزقك وأكرمك الله فى الدارين وجعل الله هذا العمل فى ميزان حسناتك وفرج الله عنك كربات يوم القيامة كما أكرمك وفرجت عنا هذه الكربة ....وهذا بالفعل المطلوب...شكراً جزيلاً لك وجزاك الله خير الثواب

03-10-2020 05:19 مساء
مشاهدة مشاركة منفردة [5]
hassona229
مشرف عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2018
رقم العضوية : 9257
المشاركات : 798
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 13-9-1980
يتابعهم : 0
يتابعونه : 10
قوة السمعة : 4030
عدد الإجابات: 110
 offline 
look/images/icons/i1.gif تعديل كود اضافة صف للإجمالى مرتين خلال نفس الشهر-للأستاذ ســلــيم حــاصــبيا
جزاكم الله خيرا علي دعائك الطيب
والحمد لله الذي بنعمته تتم الصالحات 



الكلمات الدلالية
تعديل ، اضافة ، للإجمالى ، مرتين ، خلال ، الشهر-للأستاذ ، ســلــيم ، حــاصــبيا ،


 










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

الساعة الآن 07:27 صباحا