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 45 46 47 48 49 50 51 52
|
Dim j As Integer
Dim i As Long
Dim strTEmp As String
Dim StrTAB() As String
Dim strMessage As String
Dim bol As Boolean
i = 2
ReDim Preserve StrTAB(1, 1)
Do While Not Range("A" & i).Value = vide
bol = False
'Action si 20sec
If Range("E" & i).Value = "20sec" Then
strTEmp = Range("A" & i).Value & Range("D" & i).Value
'Boucle sur la variable tableau pour rechercher si deja trouvé
If UBound(StrTAB, 2) >= 0 Then
For j = 0 To UBound(StrTAB, 2)
'Si on trouve on incrémente le compteur
If StrTAB(0, j) = strTEmp Then
StrTAB(1, j) = Val(StrTAB(1, j)) + 1
bol = True
End If
Next j
End If
'Si pas trouvé on créait
If bol = False Then
j = UBound(StrTAB, 2) + 1
ReDim Preserve StrTAB(1, j)
StrTAB(0, j) = strTEmp
StrTAB(1, j) = 1
End If
End If
i = i + 1
Loop
'Boucle pour chercher les pairs >= 3
For j = 1 To UBound(StrTAB, 2)
If Val(StrTAB(1, j)) >= 3 Then
strMessage = strMessage & StrTAB(0, j) & " : " & StrTAB(1, j) & Chr(13)
End If
Next j
MsgBox strMessage |
Partager