طلب كود vba excel لملء جدول الاحصائيات وشكرا

[hicham2610]

السلام عليكم

الإخوة الكرام

من فضلكم 

لدي ثلاث ملفات لمؤسسات 

وملف إحصاء

كيف أبرمج زر ملء في ملف إحصاء بحيث يتم ملء الجدول بالاحصائيات للمؤسسات حسب المستوى مع عدم المس بملفات المؤسسات والأخذ بعين الاعتبار  قد يصل عدد التلاميذ في القسم إلى 60 تلميذا

وجزاكم الله خيرا

الملف.rar

[أ / محمد صالح]

عشوائية عدد أقسام كل مستوى هو الذي يصعب عليك مهمتك

يفضل أن يكون كل مستوى بجميع أقسامه في شيت واحد وبنفس الاسم في جميع المؤسسات

والأفضل تجميع كل المستويات في شيت واحد في ملف إحصائيات والاعتماد على معادلات العد

بالتوفيق

[hicham2610]

السلام عليكم

أستاذي الكريم أ / محمد صالح

شكرا جزيلا لردك

بخصوص ملفات المؤسسات فهي من المصدر تكون كذلك بحيث يخصص لكل قسم ورقة

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

[hicham2610]

السلام عليكم

من فضلكم لدي كود في الزر ملف xlsm مع عدم التغيير في الملفات الثلاثة الأخرى

Sub aargh()
    Application.ScreenUpdating = False
    chemin = "d:\downloads\" 'répertoire où se trouvent les fichiers listeleve
    Set wsr = ThisWorkbook.Sheets("feuil1") ' feuille statistiques
    Dim tabstat(6, 2, 20) '6 années, 2 genres, jusqu'à 20 établissements
    Dim etab(20) 'établissements
    nf = Dir(chemin & "listeleve*.xls") 'on cherche le premier fichier qui correspond au filtre
    ctr = 0
    Do While nf <> "" 'tant qu'on a un fichier qui correspond au filtre
        Set wb = Workbooks.Open(chemin & nf)
        If Range("K12") = "Etablissement" Then
            ctre = ctre + 1
            etab(ctre) = Range("N12")
            For Each ws In wb.Worksheets
                With ws
                    If .Range("K14") = "Classe" Then 'vérification que la feuille a la bonne structure
                        classe = Val(Left(.Range("N14"), 1)) 'année
                        If classe > 0 Then 'si pas préscolaire
                            dlws = .Cells(Rows.Count, "L").End(xlUp).Row 'dernière ligne utile
                            tabstat(classe, 1, ctre) = tabstat(classe, 1, ctre) + Application.CountIf(Range("L18:L" & dlws), "Fille") 'comptage Filles
                            tabstat(classe, 2, ctre) = tabstat(classe, 2, ctre) + Application.CountIf(Range("L18:L" & dlws), "Garçon") 'comptage Garçons
                        End If
                    Else
                        MsgBox "feuille " & ws.Name & " du fichier " & nf & " n'a pas le format attendu, feuille ignorée"
                    End If
                End With
            Next ws
        Else
            MsgBox "fichier " & nf & " n'a pas le format attendu, fichier ignoré"
        End If
        wb.Close False
        nf = Dir() 'fichier suivant
    Loop
    ' mise en page des résultats
    With wsr.Range("C12") 'base du tableau de résultats
        For i = 1 To ctre
            .Offset(i - 1, -1) = etab(i) 'établissement
            For j = 1 To 6
                col = (j - 1) * 2
                .Cells(i, col + 2) = tabstat(j, 1, i) 'filles
                .Cells(i, col + 1) = tabstat(j, 1, i) + tabstat(j, 2, i) 'total
            Next j
        Next i
    End With
End Sub

الكود السابق يعطي أخطاء في الاحصائيات وجزاكم الله خيرا

Etablissements.rar