Sub CollectRatio()
Call Table_Initialize
Application.ScreenUpdating = False
Dim WorkbookMaster As Workbook, WorkbookSlave As String
Dim Ratio, KeyValue, Table, TabTotal
Dim i As Integer, LastRowTab As Integer, NbFile As Integer, IndexFile As Integer, Nb As Single, Progress As Single
Set WorkbookMaster = ActiveWorkbook
Set Ratio = WorkbookMaster.Sheets("Tableau")
WorkbookSlave = Dir(ActiveWorkbook.Path & "\KV*.xls")
Do While WorkbookSlave <> ""
NbFile = NbFile + 1
WorkbookSlave = Dir ' Classeur suivant
Loop
ProgressUserForm.Show
Nb = 0
Progress = 0
WorkbookSlave = Dir(ActiveWorkbook.Path & "\KV*.xls")
Do While WorkbookSlave <> ""
Set KeyValue = Workbooks.Open(ActiveWorkbook.Path & "\" & WorkbookSlave)
Set Table = KeyValue.Sheets("Tableau")
LastRowTab = Range("A6").End(xlDown).Row 'Dernière ligne de la base de données esclave
TabTotal = Range("A6:W" & LastRowTab) 'Mise en place des valeurs dans le tableau esclave
For i = LBound(TabTotal) To UBound(TabTotal)
Nb = Nb + 1
If Nb Mod Round(((LastRowTab * NbFile) / 100), 0) = 0 Then
Progress = Progress + 1
ProgressUserForm.ProgressBar.Width = Progress * 3.64
ProgressUserForm.ProgressPourcent.Caption = Progress & "%"
DoEvents
End If
If Len(TabTotal(i, 20)) <> 0 And TabTotal(i, 21) = "1" And Len(TabTotal(i, 22)) <> 0 And TabTotal(i, 23) = "1" And Ratio.Cells(i + 5, 5) = TabTotal(i, 5) And Ratio.Cells(i + 5, 6) = TabTotal(i, 6) Then
Counter(i) = Counter(i) + 2
If IndexFile + 1 = NbFile Then
Ratio.Cells(i + 5, 8) = (Ratio.Cells(i + 5, 8) + Cells(i + 5, 20).Value + Cells(i + 5, 22).Value) / Counter(i)
Else
Ratio.Cells(i + 5, 8) = Ratio.Cells(i + 5, 8) + Cells(i + 5, 20).Value + Cells(i + 5, 22).Value
End If
ElseIf Len(TabTotal(i, 20)) <> 0 And TabTotal(i, 21) = "1" And Ratio.Cells(i + 5, 5) = TabTotal(i, 5) And Ratio.Cells(i + 5, 6) = TabTotal(i, 6) Then
Counter(i) = Counter(i) + 1
If IndexFile + 1 = NbFile Then
Ratio.Cells(i + 5, 8) = (Ratio.Cells(i + 5, 8) + Cells(i + 5, 20).Value) / Counter(i)
Else
Ratio.Cells(i + 5, 8) = Ratio.Cells(i + 5, 8) + Cells(i + 5, 20).Value
End If
ElseIf Len(TabTotal(i, 22)) <> 0 And TabTotal(i, 23) = "1" And Ratio.Cells(i + 5, 5) = TabTotal(i, 5) And Ratio.Cells(i + 5, 6) = TabTotal(i, 6) Then
Counter(i) = Counter(i) + 1
If IndexFile + 1 = NbFile Then
Ratio.Cells(i + 5, 8) = (Ratio.Cells(i + 5, 8) + Cells(i + 5, 22).Value) / Counter(i)
Else
Ratio.Cells(i + 5, 8) = Ratio.Cells(i + 5, 8) + Cells(i + 5, 22).Value
End If
End If
Next
Application.DisplayAlerts = False
Workbooks(WorkbookSlave).Close
IndexFile = IndexFile + 1
WorkbookSlave = Dir ' Classeur suivant
Loop
ProgressUserForm.Hide
Application.ScreenUpdating = True
End Sub