Sub AddLists()
Const S = 44
Dim Mn As Worksheet
Dim Dist As Worksheet
Dim List As Worksheet
Dim Arr As Variant
Dim Temp As Variant
Dim x As Integer, y As Integer, z As Integer
Dim LR As Long, n As Long, i As Long, j As Long, p As Long
Application.ScreenUpdating = False
Set Mn = Sheets("Main")
Set Dist = Sheets("ورقة2")
Set List = Sheets("Legan")
List.Range("D8") = 1
List.Range("I8") = 2
On Error Resume Next
List.Range("B47:J" & List.Range("H" & Rows.Count).End(xlUp).Row + 46).Clear
x = WorksheetFunction.Max(Dist.Range("E8:E" & Dist.Range("H" & Rows.Count).End(xlUp).Row))
If x Mod 2 = 1 Then
y = Int(x / 2)
Else
y = Int(x / 2) - 1
End If
z = y * S + 46
If y > 1 Then
List.Range("B3:J46").Copy
For n = 47 To z Step 44
List.Range("B" & n).PasteSpecial xlPasteAll
List.Range("D" & n + 5) = List.Range("D" & n - 39) + 2
List.Range("I" & n + 5) = List.Range("I" & n - 39) + 2
Next
End If
List.Range("B8").Select
Application.CutCopyMode = False
For n = 11 To z Step 44
List.Range("B" & n & ":J" & n + 29).ClearContents
List.Range("D" & n + 31 & ":E" & n + 33).ClearContents
List.Range("I" & n + 31 & ":J" & n + 33).ClearContents
Next
Application.ScreenUpdating = True
End Sub
Sub FillLists()
Dim Mn As Worksheet
Dim Dist As Worksheet
Dim List As Worksheet
Dim LR As Long, n As Long, i As Long, p As Long, q As Long
Dim x, y, z
Dim xx, yy, zz
Set Mn = Sheets("Main")
Set Dist = Sheets("ورقة2")
Set List = Sheets("Legan")
LR = Mn.Range("D" & Rows.Count).End(xlUp).Row
For n = 8 To List.Range("D" & Rows.Count).End(xlUp).Row Step 44
For i = 8 To LR
If Mn.Cells(i, "S") = List.Cells(n, "D") Then
p = p + 1
List.Cells(p + n + 2, "C") = Mn.Cells(i, "D")
List.Cells(p + n + 2, "D") = Mn.Cells(i, "B")
List.Cells(p + n + 2, "E") = Mn.Cells(i, "G")
List.Cells(p + n + 2, "B") = p
x = WorksheetFunction.CountIf(List.Range("E" & n + 3 & ":E" & n + 32), "*" & "مسلم" & "*")
y = WorksheetFunction.CountIf(List.Range("E" & n + 3 & ":E" & n + 32), "*" & "مسيحى" & "*")
List.Range("D" & n + 35) = x
List.Range("D" & n + 36) = y
List.Range("D" & n + 34) = x + y
End If
Next
p = 0
For i = 8 To LR
If Mn.Cells(i, "S") = List.Cells(n, "I") Then
q = q + 1
List.Cells(q + n + 2, "H") = Mn.Cells(i, "D")
List.Cells(q + n + 2, "I") = Mn.Cells(i, "B")
List.Cells(q + n + 2, "J") = Mn.Cells(i, "G")
List.Cells(q + n + 2, "G") = q
xx = WorksheetFunction.CountIf(List.Range("J" & n + 3 & ":J" & n + 32), "*" & "مسلم" & "*")
yy = WorksheetFunction.CountIf(List.Range("J" & n + 3 & ":J" & n + 32), "*" & "مسيحى" & "*")
List.Range("I" & n + 35) = xx
List.Range("I" & n + 36) = yy
List.Range("I" & n + 34) = xx + yy
End If
Next
q = 0
Next
End Sub
[1]
عضوية موثقة
توزيع اللجان دفعة واحدة بالأكواد
تحميل محتوى الموضوع
عرض نسخة صالحة للطباعة
أرسل هذا الموضوع إلى صديق
