Option Explicit
'+++++++++++++++++++++++++++++++++++++++++
Dim R As Worksheet, _
L As Worksheet, M As Worksheet
Dim Date1 As Date, Date2 As Date
Dim Ro_r%, Ro_sh%, x%, col%, t%, i%
Dim Look_Range As Range, Bol As Boolean
Dim My_sum#, SuM_Befor#, arr(1 To 4)
'+++++++++++++++++++++++++++++++++++++++++
Sub My_Summ()
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
arr(1) = "Laho T": arr(2) = "Laho Y"
arr(3) = "Menho T": arr(4) = "Menho Y"
For i = 1 To 4
Sheets(arr(i)).Range("A1"). _
CurrentRegion.Interior.ColorIndex = xlNone
Next
Set R = Sheets("Repport")
R.Range("B2:E26").ClearContents
R.Range("B1:E1").ClearContents
Date1 = Application.Min(R.Range("F2:G2"))
Date2 = Application.Max(R.Range("F2:G2"))
Ro_r = R.Cells(Rows.Count, 1).End(3).Row
Select Case UCase(R.Range("F6"))
Case "T"
Set L = Sheets("Laho T")
Set M = Sheets("Menho T")
Case "Y"
Set L = Sheets("Laho Y")
Set M = Sheets("Menho Y")
Case Else: GoTo End_Me
End Select
With L
R.Cells(1, "B") = .Name & " _Befor"
R.Cells(1, "C") = .Name
Set Look_Range = .Range("A1:Ac1")
Ro_sh = .Cells(Rows.Count, 1).End(3).Row
For x = 2 To Ro_r - 1
If Not Bol Then
col = Look_Range.Find(R.Cells(x, 1), lookat:=1).Column
Bol = True
End If
For t = 2 To Ro_sh
If .Cells(t, 1) < Date1 Then
SuM_Befor = SuM_Befor + Val(.Cells(t, col))
.Cells(t, col).Interior.ColorIndex = 6
End If
If .Cells(t, 1) >= Date1 And .Cells(t, 1) <= Date2 Then
My_sum = My_sum + Val(.Cells(t, col))
.Cells(t, col).Interior.ColorIndex = 35
End If
Next t
R.Cells(x, 2) = SuM_Befor: SuM_Befor = 0
R.Cells(x, 3) = My_sum: My_sum = 0: Bol = False
Next x
End With
'+++++++++++++++++++++++++++++
With M
R.Cells(1, "D") = .Name & " _Befor"
R.Cells(1, "E") = .Name
Set Look_Range = .Range("A1:Ac1")
Ro_sh = .Cells(Rows.Count, 1).End(3).Row
For x = 2 To Ro_r - 1
If Not Bol Then
col = Look_Range.Find(R.Cells(x, 1), lookat:=1).Column
Bol = True
End If
For t = 2 To Ro_sh
If .Cells(t, 1) < Date1 Then
SuM_Befor = SuM_Befor + Val(.Cells(t, col))
.Cells(t, col).Interior.ColorIndex = 6
End If
If .Cells(t, 1) >= Date1 And .Cells(t, 1) <= Date2 Then
My_sum = My_sum + Val(.Cells(t, col))
.Cells(t, col).Interior.ColorIndex = 35
End If
Next t
R.Cells(x, 4) = SuM_Befor: SuM_Befor = 0
R.Cells(x, 5) = My_sum: My_sum = 0: Bol = False
Next x
End With
End_Me:
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub
[3]
تعديل كود الاستاذ سليم منه وله واستدعاء البيانات
تحميل محتوى الموضوع
عرض نسخة صالحة للطباعة
أرسل هذا الموضوع إلى صديق
