Discussion :

[msow86]

Bonjour,

Je souhaiterais rechercher avec un code VBA, un mot (BDO) dans plusieurs cellules sur plusieurs feuilles et de calculer la somme des distances données sur une autre colonne: Pour faire simple voici le code :

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
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
Private Sub CommandButton1_Click()
Dim R As Long, TB()
Dim i As Integer
Dim s As Integer
Dim j As Integer
Dim post As Integer
Dim init As Integer
Dim mm As Integer
Dim finn As Integer, postef1
 
    'Sheets("Feuil1").Columns(8).ClearContents
   ' Sheets("Feuil1").Columns(9).ClearContents
   ' Sheets("Feuil1").Columns(7).ClearContents
    R = RechFind(Range("A1"), ThisWorkbook.Name, "1", Range("O8:O27").Address, TB())
 
    finn = 27            ' derni?re ligne avec valeur de longueur
    init = 8             ' premi?re ligne avec valeur de longueur
    postef1 = 7
    If R > 0 Then
 
        s = 0           'calcul de longueur entre BDO
 
           For i = 0 To R - 1         ' nombre de BDO trouv?
 
           post = CInt(Range(TB(i)).Row)
 
             For j = init To post
 
               mm = CInt(Sheets("1").Cells(j, 5).Value)
 
                 s = s + mm
 
                Sheets("recap").Cells(2, postef1) = "Longueur" & init - 7
                Sheets("recap").Cells(3, postef1) = s
 
             Next j
 
            init = post + 1
            mm = Empty
            s = Empty
            postef1 = postef1 + 1
 
            'Sheets("Feuil1").Cells(3 + init, 8) = "Longueur"
 
           Next i
 
                If post < finn Then
 
                        init = post + 1
 
                             For j = init To finn
 
                             mm = CInt(Sheets("1").Cells(j, 5).Value)
 
                             s = s + mm
 
 
                            Next j
 
                Sheets("recap").Cells(2, postef1) = "Longueur" & init - 7
                Sheets("recap").Cells(3, postef1) = s
 
                End If
 
    Else
 
          For j = init To finn
 
                             mm = CInt(Sheets("1").Cells(j, 5).Value)
 
                             s = s + mm
 
              Next j
 
                             Sheets("recap").Cells(2, postef1) = "Longueur" & init - 7
                             Sheets("recap").Cells(3, postef1) = s
            mm = Empty
            s = Empty
            postef1 = postef1 + 1
    End If
 
 
 
End Sub
 
Option Explicit
Option Base 1
Option Compare Text
 
'Retourne toutes les adresses trouvées dans la recherche
'WkbN = nom du classeur, avec cette donnée la fonction peut étre mise dans un xla
'WksN = nom de la feuille
'Plage = les coordonn?es de la plage ? parcourir.
'Retour dans le tableau donner en argument.
Function RechFind(ByVal Cle As String, ByVal WkbN As String, ByVal WksN As String, ByVal Plage As String, ByRef TBadress() As Variant) As Long
Dim Cherche, Ix As Long, PrAddress
  'Ix = 0
 
    With Workbooks(WkbN).Sheets(WksN).Range(Plage)
        Set Cherche = .Find(Cle)
 
        Sheets("recap").Cells(3, 8) = Cherche
 
        If Not Cherche Is Nothing Then
            PrAddress = Cherche.Address
            Do
                ReDim Preserve TBadress(Ix)
                TBadress(Ix) = Cherche.Address
                Set Cherche = .FindNext(Cherche)
                Ix = Ix + 1
            Loop While Not Cherche Is Nothing And Cherche.Address <> PrAddress
        End If
    End With
    'nombre d'occurence(s) trouv?e(s), Retour 0 si aucune occurence
    RechFind = Ix
    Set Cherche = Nothing 'Lib?re la m?moire occup?e par l'objet.
End Function

je vous mets le fichier,

cela marche si je ne trouve pas BDO, si je trouve le programme bloc au niveau ReDim Preserve, je ne comprends.

je voudrais vraiment de l'aide. Merci beaucoup.

j'ai oublié le fichier.

[Menhir]

La variable Ix n'est pas renseignée.
En plus, comme elle n'est pas non plus typée, elle est initialisée à Nothing ce qui ne risque pas de passer pour un dimensionnement de variable tableau.

[msow86]

La variable Ix n'est pas renseignée.
En plus, comme elle n'est pas non plus typée, elle est initialisée à Nothing ce qui ne risque pas de passer pour un dimensionnement de variable tableau.

je viens de le typer mais j'ai la même erreur

[Menhir]

Si tu ne corriges qu'une erreur sur deux dans ce qu'on t'indique, ça ne va pas avancer très vite...

[msow86]

Si tu ne corriges qu'une erreur sur deux dans ce qu'on t'indique, ça ne va pas avancer très vite...

Bonjour,

Oui je veux bien, mais je ne sais pas comment faire, j'ai juste changé cette partie :

avant

Code :

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

1
2
Dim Cherche, Ix As Long, PrAddress
  'Ix = 0

après

Code :

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

1
2
Dim Cherche
Dim Ix As Long, PrAddress

[Menhir]

Tu ne donnes aucune valeur à Ix.
Comment veux-tu que Redim modifie la dimension de ta variable tableau si tu ne lui dis pas qu'elle est la nouvelle dimension ?