1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44
|
'Macro sur le remplissage de la base de comptage
Private Sub Remplir_BDD_Click()
Dim Wb As Object
Dim f, l, c, cpt, nb As Integer
Dim str As String
'Chemin du fichier
str = Worksheets(3).Range("C10")
Set Wb = GetObject(str & ".xlsx")
cpt = 0
'Nombre de feuille présente dans le classeur excel. Changement du format heure et date
nb = Worksheets(3).Range("G3")
Wb.Worksheets(1).Range("C2:C1000").NumberFormatLocal = "hh:mm"
Wb.Worksheets(1).Range("G2:G1000").NumberFormat = "dd / mm / yy"
'3 boucles imbriquées. 1) Sur les feuilles du classeur, 2) sur les lignes du tableau, 3) sur les colonnes du tableau.
'Si la feuille n'est pas la 2 alors on regarde les valeurs ayant un indice décalé par la variable compteur.
'Sinon, pas de décalage avec la variable compteur.
'Deuxième test : si une cellule avec un indice décalé par le compteur est égale à la cellule A2
'(=si le numéro est le même) alors rien, sinon on incrémente le compteur de 1.
For f = 2 To nb
For l = 2 To 400
For c = 1 To 10
If f = 2 Then
Wb.Worksheets(1).Cells(l, c) = Wb.Worksheets(2).Cells(l, c)
Else
Wb.Worksheets(1).Cells(l + cpt, c) = Wb.Worksheets(f).Cells(l, c)
End If
Next c
If IsEmpty(Wb.Worksheets(f).Cells(l, 1)) Then
cpt = l + cpt
Exit For
End If
If Wb.Worksheets(1).Cells(l + cpt, 1) <> Wb.Worksheets(f).Cells(2, 1) Then cpt = cpt + 1
If IsEmpty(Wb.Worksheets(1).Cells(l, 1)) Then Wb.Worksheets(1).Cells(l, 1).EntireRow.Delete
Next l
Next f
End Sub |
Partager