Discussion :

[phenixs]

Bonjours a tous

Je suis en train d'écrire un prog en vba me permettant de faire un certain nombre de calcule dans un classeur Excel.
Après plusieurs heures, bloquées sur une fonction, je fais appel à votre savoir...

J’ai deux feuille de calcule :

Feuille N1
- 30 000 lignes d'information
- sur 10 colonnes
- dans chaque cellule des chaines de caractères, exemple, le contenue de la cells(2,3) est « 300 255 262 247 900 »
- même type d'information (chaines de nombre séparée par un espace) pour chaque cellule

Feuille N2
- Colonne A : code de 1 à 999 (+1 par ligne)
- Colonne B : désignation du code
- Colonne C : A REMPLIR

Je souhaiterai écrire une macro [pour le boulot, qui me permet te de compter dans "la colonne C" le nombre de ligne de ma feuille N1 qui contient au moins une fois le CODE dans la chaine de caractère d’une ou plusieurs cellule de cette ligne
J’ai essayé pas mal de truc : fonction find, for each … mais j n’arrive pas a mon résultat

Merci pour votre aide
phenixs

[bidou]

il y a un million de manière de faire ça.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Dim MaCell As Range, Tableau As Variant, FeuilleCible As Worksheet
Dim cmptLig As Long, cmptCol As Long, NbLigne As Long
 
Set FeuilleCible = ThisWorkbook.Worksheets("Sheet2")
Tableau = ThisWorkbook.Worksheets("Sheet1").UsedRange.Value
For Each MaCell In FeuilleCible.Range(FeuilleCible.Cells(3, 1), FeuilleCible.Cells(3, 1).End(xlDown))
    If MaCell.Value = 214 Then Debug.Print "toto"
    For cmptLig = 1 To UBound(Tableau, 1)
        For cmptCol = 1 To UBound(Tableau, 2)
            If InStr(1, CStr(Tableau(cmptLig, cmptCol)), CStr(MaCell.Value)) > 0 Then
                NbLigne = NbLigne + 1
                Exit For
            End If
        Next cmptCol
    Next cmptLig
    MaCell.Offset(, 2).Value = NbLigne
    NbLigne = 0
Next MaCell

[J.Michel]

Une autre façon possible en utilisant la méthode Find:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Sub Test()
    Dim MyCel As Range      'Cellule de recherche
    Dim SourceCel As Range  'Cellule source
    Dim Compteur As Long    'Compteur
    Dim Ligne As Long       'Ligne de la cellule de recherche
    Dim Valeur As String    'Valeur a rechercher
    Dim Securite As Integer 'Sécurite au cas ou il n'existe qu'une valeur
 
    'Pour chaque cellule de la colonne A de la feuille 2
    For Each SourceCel In Range(Sheets(2).Range("A65536").End(xlUp), Sheets(2).Range("A3"))
        'Valeur a rechercher
        Valeur = SourceCel.Value
 
        'Activation de la cellule A1 de la feuille 1
        Sheets(1).Activate
        Range("A1").Activate
 
        'Initialisation des variables
        Securite = 0
        Compteur = 0
        Ligne = 1
 
        'Recherche de la valeur
        Set MyCel = Cells.Find(What:=Valeur)
 
        'Si une valeur est trouvée
        If Not (MyCel Is Nothing) Then
            'On recherche tant qu'il existe des valeur plus loin dans la feuille
            Do Until (MyCel Is Nothing) Or (Ligne > MyCel.Row)
                If Ligne <> MyCel.Row Then
                    ' + 1 si valeur trouvée dans une nouvelle ligne
                    Compteur = Compteur + 1
                    Ligne = MyCel.Row
                    Securite = 0
                ElseIf Securite = 10 Then
                    'Sortie de boucle après 10 boucle sur la même ligne
                    Exit Do
                Else
                    'Compteur de securite
                    Securite = Securite + 1
                End If
 
                'Recherche de la valeur suivante
                Set MyCel = Cells.FindNext(After:=MyCel)
            Loop
        End If
 
        'Affichage du compteur
        SourceCel.Offset(0, 2).Value = Compteur
    Next
End Sub