تعديل كود تقرير شهرى ليصبح من خلال تاريخ

[abouelhassan]

انا عايز معادلة جمع للصف مكانها

مع خالص تحياتي لحضرتك

[سليم حاصبيا]

استبدل هذا السطر 

R.Cells(Ro, 9) = "Global Sum"

بهذا

R.Cells(Ro, 9).Formula =  _
"=SUM(C" & Ro & ":G" & Ro & ")"

 

[abouelhassan]

كل الشكر والتقدير والاحترام لحضرتك

حبيبي يا باشا والله,,,معلش لو عايز الكود فى حالة أن مفيش رقم مايكتبش صفر...جزاكم الله خيرا

 

[سليم حاصبيا]

الموضوع اخذ من الوقت اكثر مما يحتاحه

أرجو ان يكون أخر سؤال

الكود لعدم ادراج اصفار

Option Explicit

Sub Trasfer_data_Special()
  Dim R          As Worksheet, Act_sh As Worksheet
  Dim k%, col%, Ro%
  Dim Max_ro%, x%, y%
  Dim Bol        As Boolean
  Dim ST_Dat     As Date
  Dim End_Dat    As Date
  Dim My_sum#
  Dim Mot$
  
Mot = "الاجمالى"

Set R = Sheets("Report_Youmi")
Ro = R.Cells(Rows.Count, 1).End(3).Row
R.Range("C3").CurrentRegion.Resize(Ro - 1).ClearContents
R.Cells(3, 9).Resize(Ro - 2).ClearContents
ST_Dat = Application.Min(R.Range("I2:J2"))
End_Dat = Application.Max(R.Range("I2:J2"))

For k = 3 To Ro - 2

      Bol = Application.Evaluate _
        ("ISREF('" & R.Range("A" & k) & "'!A1)")
    If Bol Then
        Set Act_sh = Sheets(R.Range("A" & k) & "")

        Max_ro = Act_sh.Cells(Rows.Count, 1).End(3).Row
        For y = 3 To 7
            For x = 5 To Max_ro

                If CDate(Act_sh.Cells(x, 1)) >= ST_Dat And _
                   CDate(Act_sh.Cells(x, 1)) <= End_Dat And _
                   Act_sh.Cells(x, 2) <> Mot Then
                   My_sum = My_sum + IIf(IsNumeric(Act_sh.Cells(x, y + 2)), _
                     Act_sh.Cells(x, y + 2), 0)

               End If
               
            Next x
            R.Cells(k, y).Value = My_sum: My_sum = 0
       Next y
    End If
Next k
'+++++++++++++++++++++++++++++++++

R.Cells(Ro - 1, 3).Resize(, 5).Formula = _
"=Sum(C$4:C$" & Ro - 2 & ")"
R.Cells(Ro, 3).Resize(, 5).Formula = _
"=Sum(C$7:C$17)"

R.Cells(4, 9).Resize(Ro - 3).Formula = _
"=IF(COUNTA($C4:$G4)>0,SUM($C4:$G4),"""")"

R.Range("A3:I" & Ro).Value = _
R.Range("A3:I" & Ro).Value
End Sub

 

[سليم حاصبيا]

تصحيح

Option Explicit

Sub Trasfer_data_Special()
  Dim R          As Worksheet, Act_sh As Worksheet
  Dim k%, col%, Ro%
  Dim Max_ro%, x%, y%
  Dim Bol        As Boolean
  Dim ST_Dat     As Date
  Dim End_Dat    As Date
  Dim My_sum#
  Dim Mot$
  
Mot = "الاجمالى"

Set R = Sheets("Report_Youmi")
Ro = R.Cells(Rows.Count, 1).End(3).Row
R.Range("C3").CurrentRegion.Resize(Ro - 1).ClearContents
R.Cells(3, 9).Resize(Ro - 2).ClearContents
ST_Dat = Application.Min(R.Range("I2:J2"))
End_Dat = Application.Max(R.Range("I2:J2"))

For k = 3 To Ro - 2

      Bol = Application.Evaluate _
        ("ISREF('" & R.Range("A" & k) & "'!A1)")
    If Bol Then
        Set Act_sh = Sheets(R.Range("A" & k) & "")

        Max_ro = Act_sh.Cells(Rows.Count, 1).End(3).Row
        For y = 3 To 7
            For x = 5 To Max_ro

                If CDate(Act_sh.Cells(x, 1)) >= ST_Dat And _
                   CDate(Act_sh.Cells(x, 1)) <= End_Dat And _
                   Act_sh.Cells(x, 2) <> Mot Then
                   My_sum = My_sum + IIf(IsNumeric(Act_sh.Cells(x, y + 2)), _
                     Act_sh.Cells(x, y + 2), 0)

               End If
               
            Next x
           R.Cells(k, y).Value = IIf(My_sum = 0, "", My_sum): My_sum = 0
       Next y
    End If
Next k
'+++++++++++++++++++++++++++++++++

R.Cells(Ro - 1, 3).Resize(, 5).Formula = _
"=if(COUNT(C$4:C$39)>0,SUM(C$4:C$39),"""")"
R.Cells(Ro, 3).Resize(, 5).Formula = _
"=IF(COUNT(C$7:C$17)>0,SUM(C$7:C$17),"""")"

R.Cells(4, 9).Resize(Ro - 3).Formula = _
"=IF(COUNT($C4:$G4)>0,SUM($C4:$G4),"""")"

R.Range("A3:I" & Ro).Value = _
R.Range("A3:I" & Ro).Value
End Sub

 

[abouelhassan]

اكثر الله خيرك استاذنا حبيبى

لن اثقل على حضرتك هاحول اعملها بالفورمات سيلس

الكود هو هو ويعمل تمام التمام التمام التمام انا فرحان جدااااااااااااااااااااا بيه ,وادعى لحضرتك من كل قلبى اسعدك الله مثل ما تسعدنا يارب

 

[سليم حاصبيا]

الآن فهمت عليك ماذا تريد (كي لا تظهر الاصفار في اي خلية )  بدون فورمات سيلس

استبدل هذا السطر في الكود

 R.Cells(k, y).Value =  My_sum: My_sum = 0

الى

 R.Cells(k, y).Value = IIf(My_sum = 0, "", My_sum): My_sum = 0

 

[abouelhassan]

حبيبي يا استاذى اكثر الله خيرك وبارك لك 

الله يبارك لك يارب ويديك الصحة والعافية

حبيبي والله