Compter nombre de cellule carateres identiques

[oliviermuch]

Bonjour, voila je souhaite faire une macro, qui me permet de compter le nombre de fois qu'apparait chaque suite de caratere differente dans une colonne... J'ai mis un fichier d'exemple tres tres epuré pour que vous me compreniez mieux!
merci par avance a ceux et celles qui prendront le temps de m'aider.

Olivier

 

[job75]

Re : Compter nombre de cellule carateres identiques

Bonsoir,

Pas très instructif le fichier.

Et de quelle suite de caractères s'agit-il ? Toute la cellule ??

Edit : autant pour moi, je n'avais pas fait défiler le haut de la page...

A+

 

[job75]

Re : Compter nombre de cellule carateres identiques

Re,

Pour chercher le nombre de cellules sans tenir compte des doublons dans la plage A1:A10 :

=SOMMEPROD(1/NB.SI(A1:A10;A1:A10))

Edit : la plage ne doit pas comporter de cellules vides, sinon on peut écrire aussi :

=SOMMEPROD(1/NB.SI(A1:A10;""&A1:A10))

A+

 

[job75]

Re : Compter nombre de cellule carateres identiques

Re,

Vous excuserez mon 1er post, mais je n'avais pas fait défiler la feuille de votre fichier jusqu'en haut...

Voyez si le fichier joint vous convient. La macro :

Sub Comptage()
Dim d As Object, cel As Range, n As Variant
Application.ScreenUpdating = False
[E3:F65536].ClearContents
Set d = CreateObject("Scripting.Dictionary")
For Each cel In Range([A2], [A65536].End(xlUp))
If Not d.Exists(cel.Value) And cel <> "" Then d.Add cel.Value, CStr(cel.Value)
Next
[E3].Resize(d.Count, 1) = Application.Transpose(d.items)
For Each cel In Range([E3], [E65536].End(xlUp))
cel.Offset(, 1) = Application.CountIf([A:A], cel)
Next
[E3:F65536].Sort Key1:=[F3], Order1:=xlDescending, Header:=xlNo
n = Application.Match([C3], [F:F], -1)
If IsError(n) Then n = 2
Range("E" & n + 1, [F65536]).ClearContents
End Sub

A+

 

[oliviermuch]

Re : Compter nombre de cellule carateres identiques

Merci Job75,

Tout a l'air de fonctionner parfaitement, j'aurai juste une derniere petite question.
Comment adapter cette macro pour qu'elle calcul ces même valeurs sur les 5 premieres feuilles sur 6 de mon projet?

merci

 

[job75]

Re : Compter nombre de cellule carateres identiques

Bonjour oliviermuch, le forum,

Pouvez-vous préciser ce que vous souhaitez :

- 5 calculs (un par feuille), ou bien

- 1 seul calcul pour l'ensemble des 5 feuilles, mais où met-on le résultat ?

A+

 

[oliviermuch]

Re : Compter nombre de cellule carateres identiques

Bonjour,

Mon fichier comporte 6 feuilles.
feuil1....feuil6

La macro que vous m'avez concocté sera en 6 eme position.
Je voudrai ,sous la meme forme que dans le fichier joint d'origine, elargir la recherche et le comptage des items dans les 5 feuilles de données.
Exemple en feuil1 A:A j'ai 55 421/wb ; en feuil2 j'en ai 34; en feuil4 j'en ai 12, alors je voudrais que sur la feuille de calcul (feuil6) lorsque j'appui sur le bouton que la macro comptabilise pour le 421/wb=101, si mon seuil est a 100, et qu'il ne me l'affiche pas si je met le seuil a 105.
Identique avec tout les autres items .
MErci

 

[oliviermuch]

Re : Compter nombre de cellule carateres identiques

En fait pour resumer par rapport a vos questions, c'est la feuil6 la feuille de resultat, je vais par la suite essayer d'adapter la macro pour que je puisse faire un calcul d'item par feuille, et une recherche pour la totalité des 5 feuilles de données.

 

[job75]

Re : Compter nombre de cellule carateres identiques

Re,

Voyez si le fichier vous convient. Pour simplifier j'ai fait 5 feuilles identiques.

La macro :

Sub Comptage()
Dim d As Object, ws As Worksheet, cel As Range, n As Variant
Application.ScreenUpdating = False
[E3:F65536].ClearContents
Set d = CreateObject("Scripting.Dictionary")
For Each ws In Worksheets
  With ws
    If .Index < 6 Then
      For Each cel In .Range(.[A2], .[A65536].End(xlUp))
        If Not d.Exists(cel.Value) And cel <> "" Then d.Add cel.Value, CStr(cel.Value)
      Next
    End If
  End With
Next
[E3].Resize(d.Count) = Application.Transpose(d.items)
For Each cel In Range([E3], [E65536].End(xlUp))
  For Each ws In Worksheets
    With ws
      If .Index < 6 Then cel.Offset(, 1) = Application.CountIf(.[A:A], cel) + cel.Offset(, 1)
    End With
  Next
Next
[E3:F65536].Sort Key1:=[F3], Order1:=xlDescending, Header:=xlNo
n = Application.Match([C3], [F:F], -1)
If IsError(n) Then n = 2
Range("E" & n + 1, [F65536]).ClearContents
End Sub

Bien sûr si chaque feuille a un grand nombre d'items, le calcul risque d'être un peu long. Dites nous le résultat, c'est intéressant.

A+

 

[job75]

Re : Compter nombre de cellule carateres identiques

Re,

Peut-être que ceci conviendra encore mieux :

Sub Comptage()
Dim d As Object, ws As Worksheet, cel As Range, n As Variant
Application.ScreenUpdating = False
[E3:K65536].ClearContents
Set d = CreateObject("Scripting.Dictionary")
For Each ws In Worksheets
  With ws
    If .Index < 6 Then
      For Each cel In .Range(.[A2], .[A65536].End(xlUp))
        If Not d.Exists(cel.Value) And cel <> "" Then d.Add cel.Value, CStr(cel.Value)
      Next
    End If
  End With
Next
[E3].Resize(d.Count) = Application.Transpose(d.items)
For Each cel In Range([E3], [E65536].End(xlUp))
  For Each ws In Worksheets
    With ws
      If .Index < 6 Then
        n = Application.CountIf(.[A:A], cel)
        cel.Offset(, 1) = n + cel.Offset(, 1)
        cel.Offset(, .Index + 1) = n
      End If
    End With
  Next
Next
[E3:K65536].Sort Key1:=[F3], Order1:=xlDescending, Header:=xlNo
n = Application.Match([C3], [F:F], -1)
If IsError(n) Then n = 2
Range("E" & n + 1, [K65536]).ClearContents
End Sub

A+

 

[oliviermuch]

Re : Compter nombre de cellule carateres identiques

Merci beaucoup,
j'ai essayé de transposer cette macro a mon fichier.
je bug encore, du moins pas moi mais excel.
J'ai copier coller la feuil6 dans mon projet, j'ai copié aussi la macro.
Dans mon projet les items sont en colonne W, et en W1 la cellule est vide.

voici mes modifs!

Sub Comptage()

Dim d As Object, ws As Worksheet, cel As Range, n As Variant
Application.ScreenUpdating = False
[E3:K65536].ClearContents
Set d = CreateObject("Scripting.Dictionary")
For Each ws In Worksheets
With ws
If .Index < 6 Then
' j'ai modifié la ligne suivante pour mettre des W

For Each cel In .Range(.[w2], .[w65536].End(xlUp))
If Not d.Exists(cel.Value) And cel <> "" Then d.Add cel.Value, CStr(cel.Value)
Next
End If
End With
Next
' LE BUG EST A LA LIGNE SUIVANTE

[E3].Resize(d.Count) = Application.Transpose(d.items)
For Each cel In Range([E3], [E65536].End(xlUp))
For Each ws In Worksheets
With ws
If .Index < 6 Then
' j'ai modifié la ligne suivante pour mettre des W

n = Application.CountIf(.[w:w], cel)
cel.Offset(, 1) = n + cel.Offset(, 1)
cel.Offset(, .Index + 1) = n
End If
End With
Next
Next
[E3:K65536].Sort Key1:=[F3], Order1:=xlDescending, Header:=xlNo
n = Application.Match([C3], [F:F], -1)
If IsError(n) Then n = 2
Range("E" & n + 1, [K65536]).ClearContents
End Sub

 

[job75]

Re : Compter nombre de cellule carateres identiques

Re,

Les adaptations sont parfaitement correctes.

Le fichier que j'ai envoyé fonctionne-t-il bien ?

Si oui, envoyer une copie du fichier réel sur cijoint :

Cijoint.fr - Service gratuit de dépôt de fichiers

A+

 

[oliviermuch]

Re : Compter nombre de cellule carateres identiques

Merci encore pour l'aide.
Oui il fonctionne sous cette forme etant donné que je dois calculer ces valeurs dans un fichier assez gros 60Mo j'avais enormement epuré. Lorsque je lui demande sous la forme reelle de fonctionner , la il bug.
j'ai cree un fichier avec la feulle1 telle qu'elle est dans mon programme initial.Il ne reste qu'a la recopier dans les autres feuille. Pour avoir un fichier qui ressemble au mien. voici le lien pour le fichier zip, il pese plus de 3mo.
Bonne soirée

Olivier

 

[oliviermuch]

Re : Compter nombre de cellule carateres identiques

je ne suis pas familier avec les fonctions du forum...
voici le lien

Cijoint.fr - Service gratuit de dépôt de fichiers

 

[job75]

Re : Compter nombre de cellule carateres identiques

Bonsoir,

Alors là je ne vous comprends plus oliviermuch 😱

En effet pour les 5 feuilles, les colonnes W sont vides !!!!

Donc d.count = 0 et bien sûr erreur sur la ligne :

[E3].Resize(d.Count) = Application.Transpose(d.items)

Il faut au moins qu'il y ait une valeur à traiter, je pense qu'il est inutile de faire un test pour ça !!!!

A+