VBA - comptage

[ALEA()]

Bonjour,

Je voudrais une macro qui compte mes séries présentes Horiz. et Verticalement dans ma grille pour faire un contrôle et savoir si toutes les séries en HD:HH sont bien présentes.
Je joins un petit exemple (résultat en colonne HI), merci de m'indiquer comment adapter la grandeur de ma plage?

Merci de votre aide.

 

[Nairolf]

Salut,

Le problème que tu as proposé n'est pas simple, je pense que c'est pour cela que tu n'as pas encore eu de réponse.

Je me suis basé sur un code trouvé sur le net et j'ai ajouté du code pour créer une fonction qui fait le travail, et cela donne ceci (nettement améliorable):
La fonction à mettre dans une formule:

=commun($A$1:$T$20;HD1;HE1;HF1;HG1;HH1)

Le code de cette fonction:

Function cbase(ByVal nb As Currency, base As Integer, nbpos As Byte) As String
Dim repnomb As String
Dim modu As Variant
Dim divi As Currency
Do
divi = Int((nb / base))
modu = nb - (divi * base)
If modu > 9 Then modu = Chr(modu + 55)
repnomb = modu & repnomb
nb = divi
Loop Until nb < base
If nb > 9 Then
repnomb = Chr(nb + 55) & repnomb
Else
repnomb = nb & repnomb
End If
repnomb = String(nbpos - Len(repnomb), "0") & repnomb
cbase = repnomb
End Function
Function permute(x() As Variant) As Variant 'ParamArray x()
'renvoie les permutations de 9 objet au plus
Dim collresu As New Collection
Dim nbele As Byte
Dim combi As Long
Dim stopp As Long
Dim chbase As String
Dim inexch As Integer
Dim rep() As Variant
Dim rep2 As Variant
Dim monvar As Variant
nbele = UBound(x) - LBound(x) + 1
stopp = ((nbele + 1) ^ nbele) - 1
For stopp = 1 To stopp
chbase = cbase(stopp, nbele + 1, nbele)
If InStr(1, chbase, "0") > 0 Then GoTo nr
For inexch = 1 To Len(chbase) - 1
If InStr(inexch + 1, chbase, Mid(chbase, inexch, 1)) <> 0 Then
GoTo nr
End If
Next inexch
collresu.Add (chbase)
nr:
Next stopp
ReDim rep(1 To collresu.Count)
stopp = 1
For Each monvar In collresu
chbase = ""
For inexch = 1 To nbele
a = Val(Mid(monvar, inexch, 1) - 1)
chbase = chbase & x(Val(Mid(monvar, inexch, 1) - 1))
Next inexch
rep(stopp) = chbase
stopp = stopp + 1
Next monvar
permute = rep
End Function


Function commun(rg As Range, ParamArray x() As Variant) 

Dim y()
Dim a()
Dim b()
Dim c()
Dim nb As Integer
Dim i As Integer
Dim j As Integer
Dim l As Integer

nb = 0

a = combi_tablo(rg)
Nblignex = UBound(x)

ReDim y(0 To Nblignex)

For i = 0 To Nblignex
 
    y(i) = x(i)
 
Next i

b = permute(y)

For j = 1 To 120
 
    b(j) = Val(b(j)) + 10 ^ 10
 
    For l = 1 To 16 * 20 * 2
     
        If b(j) = a(l) Then
         
            nb = nb + 1
         
        End If
     
    Next l
 
Next j

commun = nb

End Function


Function combi_tablo(rg As Range)

Dim d()
'b = rg.Columns.Count
'c = rg.Rows.Count
ReDim d(1 To 16 * 20 * 2)
aerz = UBound(d)
n1 = 1

For i = 1 To 16
 
    For j = 1 To 20
     
        d(n1) = 10 ^ 10 + 10 ^ 8 * rg.Cells(j, i).Value + 10 ^ 6 * rg.Cells(j, i + 1).Value + 10 ^ 4 * rg.Cells(j, i + 2).Value + 10 ^ 2 * rg.Cells(j, i + 3).Value + rg.Cells(j, i + 4).Value
        n1 = n1 + 1
     
    Next j

Next i

For i = 1 To 20
 
    For j = 1 To 16
     
        d(n1) = 10 ^ 10 + 10 ^ 8 * rg.Cells(j, i).Value + 10 ^ 6 * rg.Cells(j + 1, i).Value + 10 ^ 4 * rg.Cells(j + 2, i).Value + 10 ^ 2 * rg.Cells(j + 3, i).Value + rg.Cells(j + 4, i).Value
        n1 = n1 + 1
     
    Next j
 
Next i

combi_tablo = d

End Function

Sache que dans les résultats intermédiaires du code, toutes les permutations sont calculées.

 

[Nairolf]

Un complément d'information, tel que j'ai créé le code, il faut que les nombre (même de 1 chiffre) soient sur 2 digits (par exemple en saisissant '02 au lieu de 2).

 

[herve62]

Bonsoir
Je bossais sur ton cas pendant les réponses ; Eh oui pas évident j'ai passé un peu de temps
Bon comme dab. j'ai écris en VBA simple que tu puisses modifier ( j'ai annoté les boucles)
espérant que le VBA ne t'es pas inconnu
Là le fichier fonctionne pour ce que tu as demandé, ce n'est peut être pas la panacée mais bon
!!!!

 

[ALEA()]

Bonsoir Nairolf, Hervé 62

Merci beaucoup pour votre aide et vos 2 macros.
Je testerai demain sur mon vrai fichier. C'était pas simple.

Bonne soirée
Alea

 

[JBARBE]

Bonjour à tous,
Une autre suggestion en cliquant sur le bouton GO!
A tester !
Bonne journée !

 

[herve62]

Bonjour
@JBARBE
Ton code ressemble drôlement au mien!! ( de par les boucles) et je viens de tester les 2
Ton code : 82/100 d'éxecution
Le mien : 7/100 !!
Testé avec un Sub timer piquée sur ce forum !!
Vu qu'ici j'ai vu chipoter pour des économies de mémoire ( pour des 120 octets !!!!!! ??)
Faut bien rajouter quelque chose !!!!