Macro lente pour contrôle nombre caractere

**roidurif** · 23/04/2009, 12h02

Bonjour,

J'aimerai contrôler chacune des 82 colonnes de mon tableau si le nombre de caractere n'est pas dépasser (SANS PRENDRE EN COMPTE L'ENTETE DU TABLEAU) dans l'onglet BDD.

Si c'est le cas, alors la macro indique le N° de la celulle en feuil2.

mais je sais pas si je m'y prends bien, car ca mouline trop lorqu ema BDD est composée de 10000 ligne.

Il faudrait que ce soit rapide SVP, Merci de votre aide

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
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
 
Sub test ()
Dim lim1 As Range
Dim lim3 As Range
Dim lim4 As Range
Dim lim5 As Range
Dim lim7 As Range
Dim lim8 As Range
Dim lim10 As Range
Dim lim11 As Range
Dim lim20 As Range
Dim lim22 As Range
Dim lim30 As Range
Dim lim40 As Range
Dim lim100 As Range
Dim lim255 As Range
Dim lim333 As Range
Dim lim800 As Range
Dim c As Range
 
Application.ScreenUpdating = False
 
Set lim1 = _
Sheets("BDD").Range("B2:B65536") '.SpecialCells(xlCellTypeConstants, 23)
For Each c In lim1
If Len(c) > 1 Then
Sheets("Feuil2").Range("T65536").End(xlUp).Offset(1).Value = c.Address(0, 0)
End If
Next
 
Set lim3 = _
Sheets("BDD").Range("N2:N65536,AC2:AC65536,AI2:AI65536,AL2:AL65536,AP2:AP65536,BA2:BA65536") '.SpecialCells(xlCellTypeConstants)
For Each c In lim3
If Len(c) > 3 Then
Sheets("Feuil2").Range("65536").End(xlUp).Offset(1).Value = c.Address(0, 0)
End If
Next
 
Set lim4 = _
Sheets("BDD").Range("F2:F65536,J2:J65536,R2:R65536,V2:V65536,Z2:Z65536") '.SpecialCells(xlCellTypeConstants, 23)
For Each c In lim4
If Len(c) > 4 Then
Sheets("Feuil2").Range("T65536").End(xlUp).Offset(1).Value = c.Address(0, 0)
End If
Next
 
Set lim5 = _
Sheets("BDD").Range("BG2:BG65536") '.SpecialCells(xlCellTypeConstants, 23)
For Each c In lim5
If Len(c) > 5 Then
Sheets("Feuil2").Range("T65536").End(xlUp).Offset(1).Value = c.Address(0, 0)
End If
Next
 
Set lim7 = _
Sheets("BDD").Range("AX2:AX65536") '.SpecialCells(xlCellTypeConstants, 23)
For Each c In lim7
If Len(c) > 7 Then
Sheets("Feuil2").Range("T65536").End(xlUp).Offset(1).Value = c.Address(0, 0)
End If
Next
 
Set lim8 = _
Sheets("BDD").Range("AB2:AB65536,AM2:AM65536,AN2:AN65536,AW2:AW65536") '.SpecialCells(xlCellTypeConstants, 23)
For Each c In lim8
If Len(c) > 8 Then
Sheets("Feuil2").Range("T65536").End(xlUp).Offset(1).Value = c.Address(0, 0)
End If
Next
 
Set lim10 = _
Sheets("BDD").Range("A2:A65536,AJ2:AJ65536,AK2:AK65536,AO2:AO65536,BB2:BB65536,BC2:BC65536") '.SpecialCells(xlCellTypeConstants, 23)
For Each c In lim10
If Len(c) > 10 Then
Sheets("Feuil2").Range("T65536").End(xlUp).Offset(1).Value = c.Address(0, 0)
End If
Next
 
Set lim11 = _
Sheets("BDD").Range("AD2:AD65536,AF2:AF65536,AG2:AG65536,AH2:AH65536") '.SpecialCells(xlCellTypeConstants, 23)
For Each c In lim11
If Len(c) > 11 Then
Sheets("Feuil2").Range("T65536").End(xlUp).Offset(1).Value = c.Address(0, 0)
End If
Next
 
 
Set lim20 = _
Sheets("BDD").Range("BK2:BK65536,BL2:BL65536,BN2:BN65536,BO2:BO65536,BP2:BP65536,BQ2:BQ65536,BR2:BR65536,BS2:BS65536,BT2:BT65536,BW2:BW65536,BX2:BX65536,BY2:BY65536,BZ2:BZ65536,CA2:CA65536,CB2:CB65536") '.SpecialCells(xlCellTypeConstants, 23)
For Each c In lim20
If Len(c) > 20 Then
Sheets("Feuil2").Range("T65536").End(xlUp).Offset(1).Value = c.Address(0, 0)
End If
Next
 
Set lim22 = _
Sheets("BDD").Range("C2:C65536") '.SpecialCells(xlCellTypeConstants, 23)
For Each c In lim22
If Len(c) > 22 Then
Sheets("Feuil2").Range("T65536").End(xlUp).Offset(1).Value = c.Address(0, 0)
End If
Next
 
Set lim30 = _
Sheets("BDD").Range("BM2:BM65536,BU2:BU65536,BV2:BV65536,CC2:CC65536,CD2:CD65536") '.SpecialCells(xlCellTypeConstants, 23)
For Each c In lim30
If Len(c) > 30 Then
Sheets("Feuil2").Range("T65536").End(xlUp).Offset(1).Value = c.Address(0, 0)
End If
Next
 
Set lim40 = _
Sheets("BDD").Range("D2:D65536,H2:H65536,L2:L65536,P2:P65536,T2:T65536,X2:X65536,AE2:AE65536,AY2:AY65536,AZ2:AZ65536") '.SpecialCells(xlCellTypeConstants, 23)
For Each c In lim40
If Len(c) > 40 Then
Sheets("Feuil2").Range("T65536").End(xlUp).Offset(1).Value = c.Address(0, 0)
End If
Next
 
Set lim100 = _
Sheets("BDD").Range("AQ2:AQ65536,AR2:AR65536,AS2:AS65536,AT2:AT65536,AU2:AU65536,AV2:AV65536,CG2:CG65536,CH2:CH65536,CI2:CI65536,CJ2:CJ65536,CK2:CK65536,CL2:CL65536") '.SpecialCells(xlCellTypeConstants, 23)
For Each c In lim100
If Len(c) > 100 Then
Sheets("Feuil2").Range("T65536").End(xlUp).Offset(1).Value = c.Address(0, 0)
End If
Next
 
 
Set lim255 = _
Sheets("BDD").Range("G2:G65536,K2:K65536,O2:O65536,S2:S65536,W2:W65536,AA2:AA65536,BD2:BD65536,BD2:BD65536,BF2:BF65536,BI2:BI65536") '.SpecialCells(xlCellTypeConstants, 23)
For Each c In lim255
If Len(c) > 255 Then
Sheets("Feuil2").Range("T65536").End(xlUp).Offset(1).Value = c.Address(0, 0)
End If
Next
 
Set lim333 = _
Sheets("BDD").Range("BJ2:BJ65536") '.SpecialCells(xlCellTypeConstants, 23)
For Each c In lim333
If Len(c) > 333 Then
Sheets("Feuil2").Range("T65536").End(xlUp).Offset(1).Value = c.Address(0, 0)
End If
Next
 
 
Set lim800 = _
Sheets("BDD").Range("E2:E65536,I2:I65536,M2:M65536,Q2:Q65536,U2:U65536,Y2:Y65536") '.SpecialCells(xlCellTypeConstants, 23)
For Each c In lim800
If Len(c) > 800 Then
Sheets("Feuil2").Range("T65536").End(xlUp).Offset(1).Value = c.Address(0, 0)
End If
Next
 
Application.ScreenUpdating = True
 
End Sub

**aalex_38** · 23/04/2009, 12h15

Au lieu de faire ça, une solution serait peut-être d'interdire par le code la saisie dans une cellule de plus de n caractères, qu'en dis-tu ?

**Krovax** · 23/04/2009, 12h31

Plus simple, enfin si ca te vas.
Utiliser la validation de donné pour empêcher d'entrer de mauvaise infos
Va par exemple en cellule B2 dans le menu Donnée/validation dans longlet Option. Choisie autoriser Personaliser et met la formule
=NBCAR(B2)<=1
Puis copie sur toute la colonne

Sinon tu peux commencer par revoir tes ranges

Code :

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

Sheets("BDD").Range("B2:B65536")

pas la peine d'aller jusqu'à la dernière ligne

Code :

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

Sheets("BDD").Range("B2:B" & Range("B65536").End(xlUp).Row)

de plus tu peux sans doute te passer des lim1 et autres (pas forcément de gain là)

Code :

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

1
2
3
Set lim1 = _
Sheets("BDD").Range("B2:B65536") '.SpecialCells(xlCellTypeConstants, 23)
For Each c In lim1

cela revien a faire

Code :

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

For Each c In Sheets("BDD").Range("B2:B65536")

Ou si tu as de nombreuses valeur en feuille 2 éviter de rechercher a chaque fois la dernière ligne, en utilisant une variable (je n'ai jamais testé si Range("65536").End(xlUp) est "long" a exécuter)
pour cela essaye quelque chose du type de

Code :

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

1
2
3
4
5
6
7
8
9
10
Dim c As Range
dim i as long
Application.ScreenUpdating = False
i=1
For Each c In Sheets("BDD").Range("B2:B65536")
If Len(c) > 1 Then
Sheets("Feuil2").cells(i,1).Value = c.Address(0, 0)
i=i+1
End If
Next

Par contre qu'entend tu pas ca mouline trop? car tu fait quand même un bon paquet de test si tu vas jusqu'à AX ca te fait près de 600 000 tests. c'est pas rien

Edit : j'ai mis un peu de temps à le pondre ce post

bonjour aalex_38. Enfin la validation de donnée c'est exactement cette idée

**Lynx92260** · 23/04/2009, 12h39

bonjour

Pour ma part j'utilise plutôt le control visuel avec le format conditionnelle voir exemple dans fichier ci-joint

Je pense ce sera beaucoup plus rapide que par vba ......

**roidurif** · 23/04/2009, 13h07

merci Krovax et vous autres
J'essaye d'adapter ta logique pour les colonnes avec une meme limite, j'ai fait cela, mais ca marche pas?

merci

Code :

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

1
2
3
 
Set lim3 = _
Sheets("BDD").Range("N2:N,AC2:AC,AI2:AI,AL2:AL,AP2:AP,BA2:BA" & Range("N65536,AC65536,AI65536,AL65536,AP65536,BA65536").End(xlUp).Row)

Je vous joins mon fichier

merci

**Krovax** · 23/04/2009, 14h13

excel n'est pas aussi malin & permet de mettre a la suite d'une chaine de caractère une austre chaine

Si i=10, alors "abc" & i donne "abc10"

Essaye

Code :

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

1
2
3
4
5
6
7
8
 
idm i1 as long, i2 as long, i3 as long,......
 
i1=Range("N65536).End(xlUp).Row)
i2= Range("AC65536).End(xlUp).Row)
i3=....
 
Sheets("BDD").Range("N2:N" & i1& ",AC2:AC"&i2& ",AI2:AI" & i3 & ....)

**Abed_H** · 23/04/2009, 14h37

Bonjour

Code :

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

1
2
3
4
5
6
7
8
9
Sub AddressSupp()
Dim Rng As Range, xl As Integer
xl = Range("A2:CD10000").Find("*", , , , , xlPrevious).Row
For Each Rng In Range("A2:CD" & xl)
    If Len(Rng.Text) > 1 Then
         Feuil2.Cells(65536, 1).End(xlUp)(2) = Rng.Address
   End If
Next Rng
End Sub

**roidurif** · 23/04/2009, 20h43

La macro ci dessous fonctionne si la colonne a contrôler est entierement remplis. Par contre si dans cette meme colonne, on ne renseigne qu'une cellule de renseigner, et le reste vide, alors elle ne detecte rien.

Exemple en colonne CL, je renseigne la cellule CL5 à plus de 100 caraceter et le reste de la colonne reste vide. Alors il ne detecte pas, je c pas pkoi??

Vois exemple dans le fichier

Aider moi svp merci

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
 
Sub test4j()
Dim limites, i As Long, j As Long, k As Long, l As Long
Dim d As Worksheet, s As Worksheet, c As Range
limites = Split("10 1 22 40 800 4 255 40 800 4 255 40 800 3 255 40 800 4 255 40 800 4 255 40 800 4 255 8 3 11 40 11 11 11 3 10 10 3 8 8 10 3 100 100 100 100 100 100 8 7 40 40 3 10 10 255 255 255 5 1 255 333 20 20 30 20 20 20 20 20 20 20 30 30 20 20 20 20 20 20 30 30 1 1 100 100 100 100 100 100")
Set s = Sheets("Feuil2"): Set d = Sheets("BDD")
Application.ScreenUpdating = False: s.Range("T12:T65536").ClearContents: k = 12
For j = 1 To 90
 If d.Columns(j).SpecialCells(2).Count > 0 Then
 For Each c In d.Columns(j).SpecialCells(2).Offset(1, 0)
 If Len(c) > CLng(limites(j - 1)) Then
 l = CLng(limites(j - 1))
    s.Range("T" & k).End(xlUp).Offset(1).Value = c.Address(0, 0)
 k = k + 1
 End If
 Next
 End If
Next
s.Activate: Application.ScreenUpdating = True
End Sub

merci infieniment

Macro lente pour contrôle nombre caractere

Macros et VBA Excel

Discussions similaires

Partager

Partager