VBA ou formule ?

Version imprimable

Voir 40 message(s) de cette discussion en une page

28/07/2009, 16h56
Paloma

Oui Krovax, j'ai utilisé le mode debug et les 'puces':

http://ingenieurinfosi.free.fr/TEMPO/trace.jpg

Je vois bien que tout ne tourne pas rond mais j'ai du mal a comprendre pourquoi. Il faut que je relise le code à tête reposé car là vous m'avez tous donné de bonne information que j'essaye d'emmagasiner.

Bref, je vais regarder ça encore ce soir depuis chez moi.

Sinon pour Many31,

Citation 1: Je ne sais pas chez moi, ça ne fonctionne pas.

Citation 2: non non, je me suis mal explique, ce n'est pas intégré aux cellules, c'est toujours dans le même bout de programme mais sa gêne tout le reste du code.

:? ... ouille ouuille ouille, je désespère
:scarymov: tapez moi sur la tête ça ira mieux :aie:

:P
28/07/2009, 17h15
Many31
Oui mais là tu mélanges plein de chose...

Ton premier if et les Elseif qui suivent s'emmêlent carrément les pinceaux... Sachant que Elseif est une condition supplémentaire SI la première n'est PAS respectée....

Le fait d'avoir mis le 'Exit Sub en commentaire t'oblige à mettre un End if (l'action du if n'étant plus dans la continuité mais sur les lignes inférieur.)

Donc si on reprend:

Si ton Target est constitué de plusieurs cellules ou s'il n'est pas sur la colonne 4 ou s'il est vide alors tu sélectionne les cas où le nombre de caractère de Target est égal à 2 ou 4 ou 5.
Sinon si (oui c'est pas beau l'anglais) tu es dans la colonne 4 alors tu met la valeur en majuscule
Sinon si tu es dans la colonne 52 tu met en majuscule.

Si je résume ton code, tu n'interroge la forme dans la cellule que si elle n'est pas dans la colonne 4.

Dans le select case tu utilise les valeur 4 et 5 pour le nombre de caractère... je croyais que tu en voulais 2 ou 3 seulement....

Sinon le code correspond.... Juste à virer la premère ligne de IF et les Elseif et remplacer:
Code:

1 2 If Target.Cells.Count <> 1 Or Intersect(Target, Columns(4)) Is Nothing Or _ IsEmpty(Target) Then 'Exit Sub
par
Code:

1 2 3 4 5 6 7 8 9 If Target.Cells.Count = 1 And Target.Column = 4 Then 'tes select case etc. Elseif Target.Cells.Count = 1 And Target.Column = 52 Then 'Ton remplacement par des maj End if

Re,
Si tu ins:sm::zekill::pan::fessee:iste...
Bon, revenons à nos moutons..
Pas plus simple de dire "ont veux pas les i et les o" que dire dire ..ont veux bien de... toutes les possibilités testées.. ??
Ben je pense que mon code y va aller !!

Code:

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
Private Sub Worksheet_Change(ByVal Target As Range)
Dim msg_err, Buffer
    If Target.Count > 1 Or Target = "" Or Not (Not Target.Column <> 4 Or _
    Not Target.Column <> 52) Then Exit Sub
    Application.EnableEvents = False
    Select Case Target.Column
    Case 4
       'Traitement colonne 4
        Buffer = UCase(Target) 'éviter le test Minuscule
        Select Case Len(Buffer)
            Case 2
                If Not (Buffer Like "##") Then msg_err = "Please enter 2 Digits or 2 Digits and 1 Char "
            Case 4
                If Not (Buffer Like "####") Then msg_err = "Please enter 2 Digits or 2 Digits and 1 Char "
            Case 3
                If Not Left(Buffer, 2) Like "##" Or _
                 Buffer Like "##[I]" Or Buffer Like "##[O]" Then msg_err = "2 Digits and 1 Char "
            Case 5
                If Not Left(Buffer, 4) Like "####" Or _
                 Buffer Like "####[I]" Or Buffer Like "####[O]" Then msg_err = "4 Digits and 1 Char "
 
            Case Else
                msg_err = "Please enter 2 Digits or 2 Digits and 1 Char " & chr(13) & "Or 4 digits or 4 digits and 1 car"
        End Select
        If msg_err <> "" Then
            MsgBox msg_err, vbCritical + vbOKOnly, "Data : Error"
            Target.ClearContents
            Target.Select
        Else
            Target = Buffer
        End If
    Case 52
       'Traitement colonne 52
       Target = UCase(Target)
    End Select
 
    Application.EnableEvents = True
End Sub

A+ ;)

EDIT: ATTENTION ! je remarque que dans la transcription du code l'éditeur passe les [I] en minuscule, CE DOIT ETRE DES MAJUSCULES

[Résolu]

Bonjour à tous et à toutes,

Merci Many31 et merci encore à vous tous pour vos lumières et explications.

Je pense avoir a peu près tout compris (par rapport à ce que je voulais faire bien sur).

Je fourni le code complet ci-dessous. Merci de me dire ce que vous en pensez.
Je pourrai ensuite passer ce post à Résolu.

Code:

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
 
''--------------------------------------------------------------------------
''    Automatic checks and replacements during capture
''
''--------------------------------------------------------------------------
 
 
Private Sub Worksheet_Change(ByVal Target As Range)
  Application.EnableEvents = False
 
Dim Msg_Err As String
 
If Target.Cells.Count = 1 And Target.Column = 4 Then ' Column 'D'
 
'select case etc. Checks and replacement (in upper case)
Select Case Len(Target)
 
    Case 2
        If Not (Target Like "##") Then Msg_Err = _
        "Please enter 2 Digits or 2 Digits and 1 Char (except 'i' and 'o') in upper case"
        Target = UCase(Target)
 
    Case 3
        If Not (Target Like "##[0-9]") And Not (Target Like "##[A-H]") And Not (Target Like "##[J-N]") _
        And Not (Target Like "##[P-Z]") And Not (Target Like "##[a-h]") And Not (Target Like "##[j-n]") _
        And Not (Target Like "##[p-z]") Then Msg_Err = _
        "Please enter 2 Digits or 2 Digits and 1 Char (except 'i' and 'o') in upper case"
        Target = UCase(Target)
 
    Case Else
        Msg_Err = "Please enter 2 Digits or 2 Digits and 1 Char (except 'i' and 'o') in upper case"
End Select
 
End If
 
If Msg_Err <> "" Then
    MsgBox Msg_Err, vbCritical + vbOKOnly, "Data : Error"
    Target.ClearContents
 
 
ElseIf Target.Cells.Count = 1 And Target.Column = 52 Then ' Column 'AZ'
 
    'replacement (in upper case)
    Target = UCase(Target)
 
End If
 
  Application.EnableEvents = True
End Sub

Par contre, je viens de m'appercevoir (et là forcement c'est normal) si l'utilisateur se sert du copier/coller, il faut que je fasse les mêmes controles avec un bouton check.
Hum... je vais voir ce que je peu faire. Si vous avez une piste?

29/07/2009, 10h39
LeForestier

Tu ne teste plus quand il y a 4 ou 5 digits ??
Tu n'a pas regarder les test que j'ai mis dans mon code précédant ? il sont beaucoups plus simple. ?

Citation:

Par contre, je viens de m'appercevoir (et là forcement c'est normal) si l'utilisateur se sert du copier/coller, il faut que je fasse les mêmes controles avec un bouton check.

Il peuvent faire un Copier/Coller de plusieur cellules ?
29/07/2009, 10h49
Paloma

Bonjour LeForestier,

Désolé, je n'avais pas vu votre réponse.

Merci pour ces informations. En effet; il serait plus judicieux de vérifier que l'utilisateur ne doit pas pouvoir saisir de 'i' ou de 'o'.

Sinon, j'ai eu des retours de la définition de l'algo. Les demandes utilisateurs finals ont encore changés.
Il est autorisé seulement 2 digits ou 2 digits + 1 char (<> 'i' Or 'I', And <> 'o' Or O').

Mais je dois faire un bouton check en plus .... :calim2: Allez, j'y vais au boulot ;)

Merci encore.
Et dite moi ce que vous pensez de mon code.
Est-ce propre, reste-t-il des erreurs ?

A bientôt.
29/07/2009, 10h57
LeForestier

Il y a beaucoup de façon de "coder", chacun le fait à sa façon ;)
Ton code est bien indenté.
J'ajouterais quand même, Traget.Select après le ClearContents.
Et employer mon test en Case 3, il est plus rationnel. (Je l'ai testé)
Tu n'a pas répondu si le copier/Coller peu se faire avec plusieur cellules ?
29/07/2009, 11h18
Paloma

Pardon,

Oui en effet, ils ont des vieux bouts de fichiers qui sont formaté exactement de la même manière (mais sans bout de code). :(

Je vais essayer de suivre ton test en case 3. :ccool:
Je regarde aussi le target select qui si je crois devrait laisser la cellule sélectionnée.

Merci encore.
29/07/2009, 11h24
Krovax
Bonjour,
Pour gérer la modification de plusieurs cellue a la fois

dans la déclaration de vrariable ajour

Code:

dim cellule as range

puis dans le code
Code:

1 2 3 4 5 6 7 8 9 10 for each cellule in target 'tout ton code en remplacant target par cellule next cellule Application.EnableEvents = True end sub
29/07/2009, 11h39
Paloma

Bonjour Krovax,

Je vais essayer ça, merci.
Mais si il n'y a qu'une cellule de sélectionné, se sera toujours bon?

Rappel:

Soit l'utilisateur saisie cellule par cellule les informations (toujours quand c'est une nouvelle ligne).
Soit il copie et colle plusieurs lignes en même temps d'un fichier à celui-ci.

:aie: ça va crasher ça non ?
29/07/2009, 11h46
Krovax

s'il n'y a qu'un cellule il boucle sur toutes les cellule de target donc il boucle une fois :ccool:

Après si ca crash c'est que tu a mal utiliser le code :P Le mieux pour ce genre de question c'est d'essayer

Oui, ça va crasher
Et un code qui fonctionne dans tout les cas..

Code:

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
Private Sub Worksheet_Change(ByVal Target As Range)
Dim msg_err, Cel As Range
    If Not (Not Target.Column <> 4 Or Not Target.Column <> 52) Then Exit Sub
    Application.EnableEvents = False
    For Each Cel In Target
        Select Case Cel.Column
        Case 4
           'Traitement colonne 4
            If Cel <> "" Then
                msg_err = TestCellule(Cel.Value)
                If  msg_err <> "" Then
                    MsgBox msg_err, vbCritical + vbOKOnly, "Data : Error"
                    Cel.ClearContents
                    msg_err  = ""
                Else
                    Cel = UCase(Cel)
                End If
             End If
        Case 52
           'Traitement colonne 52
           Cel = UCase(Cel)
        End Select
    Next Cel
    Application.EnableEvents = True
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Function TestCellule(Buffer As String) As String
Dim msg_err
        Buffer = UCase(Buffer) 'éviter le test Minuscule
        Select Case Len(Buffer)
            Case 2
                If Not (Buffer Like "##") Then msg_err = "Please enter 2 Digits or 2 Digits and 1 Char "
            Case 3
                If Not Left(Buffer, 2) Like "##" Or _
                 Buffer Like "##[I]" Or Buffer Like "##[O]" Then msg_err = "2 Digits and 1 Char "
            Case Else
                msg_err = "Please enter 2 Digits or 2 Digits and 1 Char "
        End Select
    TestCellule = msg_err
End Function

Ont peu aussi copier un bloc dans la colonne 52
A+
Edit: Rectifier le message

29/07/2009, 14h31
Gorfael

Salut LeForestier et le forum
Euh... juste pour brocarder (juste un peu) :lol:

Code:

If Not (Not Target.Column <> 4 Or Not Target.Column <> 52) Then Exit Sub

chez moi, ça donne :

Code:

If Not (Target.Column = 4 Or Target.Column = 52) Then Exit Sub

ou

Code:

If (Target.Column <> 4 and Target.Column <> 52) Then Exit Sub

Mon problème pour répondre est que je ne comprends pas la notion de "digit". Pour moi, un "digit" est un caractère alphanumérique. Donc, comme pour répondre il faut comprendre la question et que j'ai du mal à utiliser le morceau de fromage blanc qui me sert à maintenir l'écartement entre mes oreilles...
A+
29/07/2009, 14h52
LeForestier
Bonjour Gorfael,
Hum oui, dans un sens tu a raison :oops: mais le code venait de..
Code:

1 2 If Target.Count > 1 Or Target = "" Or Not (Not Target.Column <> 4 Or _ Not Target.Column <> 5) Then Exit Sub
Et sans les "Not" ça fonctionne pas et suite aux multiple modif demandées par le posteur je n'ai gardé que cette partie et comme ça fonctionnait je n'ai pas chercher plus loin sur ces lignes.
A+ ;)
EDIT :

Citation:

DIGIT, définiton du mot DIGIT, Définition du mot DIGIT, "DIGital unIT", élément d'information numérique désignant en réalité un simple chiffre

Comme quoi tout le monde peu se tromper ..:calim2:
Mais je pense que tu confond avec les anciens affichage à Led, au début il n'y avait que des chiffres avec affichage à 7 segments ce n'est que plus tard que des segments ont étés ajoutés pour afficher de l'alphanumérique mais le terme "impropre" de Digit est rester.

Merci LeForestier et Gorfael,

Oui nous utilisons ici 'Digit' pour indiquer un simple nombre de 'n' chiffres.

Sinon, voici le code:

Code:

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
 
''--------------------------------------------------------------------------
''    Automatic checks and replacements during capture
''
''--------------------------------------------------------------------------
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim msg_err, Cel As Range
    If (Target.Column <> 4 And Target.Column <> 52) Then Exit Sub
    Application.EnableEvents = False
    For Each Cel In Target
        Select Case Cel.Column
        Case 4
           'Traitement colonne 4
            If Cel <> "" Then
                msg_err = TestCellule(Cel.Value)
                If msg_err <> "" Then
                    MsgBox msg_err, vbCritical + vbOKOnly, "Data : Error"
                    Cel.ClearContents
                    Cel.Select
                    msg_err = ""
                Else
                    Cel = UCase(Cel)
                End If
             End If
        Case 52
           'Traitement colonne 52
           Cel = UCase(Cel)
        End Select
    Next Cel
    Application.EnableEvents = True
End Sub
 
Private Function TestCellule(Buffer As String) As String
Dim msg_err
        Buffer = UCase(Buffer) 'éviter le test Minuscule
        Select Case Len(Buffer)
            Case 2
                If Not (Buffer Like "##") Then msg_err = "Please enter 2 Digits or 2 Digits and 1 Char in upper case(except 'i' or 'I' and 'o' or 'O')"
            Case 3
                If Not Left(Buffer, 2) Like "##" Or _
                 Buffer Like "##[i]" Or Buffer Like "##[I]" Or Buffer Like "##[O]" Or Buffer Like "##[O]" Then msg_err = "Please enter 2 Digits or 2 Digits and 1 Char in upper case(except 'i' or 'I' and 'o' or 'O'"
            Case Else
                msg_err = "Please enter 2 Digits or 2 Digits and 1 Char in upper case(except 'i' or 'I' and 'o' or 'O'"
        End Select
    TestCellule = msg_err
End Function

J'ai juste rajouté le 'Cel.Select' qui m'a été recommandé par LeForestier. :ccool:

Donc ça fonctionne très bien avec ce que je vous ai dit (au niveau de mon problème à résoudre qui est le long discours que nous avons déjà bien entamé)

Sauf que je n'ai pas été super clair encore une fois, veuillez m'en excuser.
Quand je parlais de copier/coller, je voulais dire des lignes entières et non colonne par colonne. Je pense donc qu'il va être difficile de modifier ce code.
Je pense que je peux le garder tel quel car ça sert déjà et c’est chouette !;)

Par contre j'ai un bouton qui check d'autre trucs dans la feuille, ne puis-je pas appeler la fonction 'TestCellule' pour vérifier ligne par ligne si la cellule est bonne pour la colonne 4? et Comment tout simplement passer toute la colonne 4 et la colonne 52 en Maj via ce bouton sans toucher aux 3 premières lignes du haut? :calim2:

Bon, je vais tenter de faire ça.

A plus tard et merci pour toutes vos explications et commentaires.

29/07/2009, 15h37
LeForestier

Mais non, test le code, j'avais prévu cette situation et le code est agencer pour fonctionner même si le bloc coller comprend d'autre colonne mais testerra uniquement les colonnes à tester.
seule modif à faire..
changer:

Code:

If (Target.Column <> 4 And Target.Column <> 52) Then Exit Sub

par

Code:

If (Target.Column <> 4 And Target.Column <> 52) and Target.Count=1 Then Exit Sub

J'avais laisser cette ligne pour éviter les test quand pas nécessaire, mais suite nouvelle modif....
A+
Edit: je relisait ton dernier poste et je vois..

Citation:

J'ai juste rajouté le 'Cel.Select' qui m'a été recommandé par LeForestier

Mais justement, ici, je ne l'ai pas mis pour éviter la redondance sur l'événement, il est même probable qu'il faudra ajouter un drapeau pour éviter cela quand c'est un bloc.

Merci à tous le monde, c'est vraiement super :ccool:

Merci LeForestier, en effet même avec un copier coller de plusieurs lignes le code vérifie ces deux colonnes.

Voici le code :

Code:

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
''--------------------------------------------------------------------------
''    Automatic checks and replacements during capture
''
''--------------------------------------------------------------------------
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim msg_err, Cel As Range
    If (Target.Column <> 4 And Target.Column <> 52) And Target.Count = 1 Then Exit Sub
    Application.EnableEvents = False
    For Each Cel In Target
        Select Case Cel.Column
        Case 4
           'Applicable on column '4'
            If Cel <> "" Then
                msg_err = TestCellule(Cel.Value)
                If msg_err <> "" Then
                    MsgBox msg_err, vbCritical + vbOKOnly, "Data : Error"
                    Cel.ClearContents
                    Cel.Select
                    msg_err = ""
                Else
                    Cel = UCase(Cel)
                End If
             End If
        Case 52
           'Applicable on column '52'
           Cel = UCase(Cel)
        End Select
    Next Cel
    Application.EnableEvents = True
End Sub
 
Private Function TestCellule(Buffer As String) As String
Dim msg_err
        Buffer = UCase(Buffer) 'éviter le test Minuscule
        Select Case Len(Buffer)
            Case 2
                If Not (Buffer Like "##") Then msg_err = "Please enter 2 Digits or 2 Digits and 1 Char in upper case(except 'i' or 'I' and 'o' or 'O')"
            Case 3
                If Not Left(Buffer, 2) Like "##" Or _
                 Buffer Like "##[i]" Or Buffer Like "##[I]" Or Buffer Like "##[o]" Or Buffer Like "##[O]" Then msg_err = "Please enter 2 Digits or 2 Digits and 1 Char in upper case(except 'i' or 'I' and 'o' or 'O'"
            Case Else
                msg_err = "Please enter 2 Digits or 2 Digits and 1 Char in upper case(except 'i' or 'I' and 'o' or 'O'"
        End Select
    TestCellule = msg_err
End Function

Par contre, j'ai voulu changer la coleur des cellules qui posent problèmes après avoir fait un "Cel.ClearContents" en faisant:

Code:

Cel.Interior.Indexcolor = 15

mais ça ne marche pas. J'ai essayé avec ...color = RGB (0,255,0) pour voir et pareil :aie:

Je colture ce post car le résultat est là mais si vous avez un tuyau pour la couleur. J'ai du mal avec l'aide en ligne d'office ... :lol: Je trouverai surement si j'étais meilleur mais si je l'étais, je n'utiliserai pas l'aide en ligne :(

Merci en tout cas à tous et merci surtout à votre bonne humeur.

31/07/2009, 11h06
LeForestier
Si tu essayais avec ColorIndex.. ça irai pas mieux ?
Code:

1 2 3 range("A1").Interior.ColorIndex = 15 'Ou range("A1").Interior.Color = rgb(255,0,255)
A+
31/07/2009, 13h44
Paloma

Oups désolé, oui c'est ce que je voulais écrire :

Citation:

Cel.Interior.ColorIndex = 15

Mais je me fais jeter. :aie:
http://ingenieurinfosi.free.fr/TEMPO/error.jpg

:(

Je comprend pas, chez moi ça fonctionne, mais au cour des test j'ai remarquer que tu a modifier la ligne Case 3 de la routine TestCellule le petit i et o ne sont pas nécessaire, je pense que tu n'a pas bien compris la remarque que j'ai mis, l'erreur entre i et I est dans l'éditeur de DVP.
J'ai aussi détecter une erreur inhérante au code que je t'ai mis, si ont tape 3 digits ça passe alors que ça ne devrait pas. Donc remplace ces lignes par...
Code:

1 2 3 Case 3 If Not Left(Buffer, 2) Like "##" Or _ Buffer Like "##[I]" Or Buffer Like "##[O]" Or Buffer Like "###" Then msg_err = "Please enter 2 Digits or 2 Digits and 1 Char in upper case(except 'i' or 'I' and 'o' or 'O'"
Et c'est sur cette ligne Buffer Like "##[I]" que tu doit remplacer le i par I. (Rien d'autre)
Et si tu trouve pourquoi le ColorIndex plante tu devrais ajouter...
Code:

1 2 3 4 5 6 7 8 9 10 11 If msg_err <> "" Then MsgBox msg_err, vbCritical + vbOKOnly, "Data : Error" Cel.ClearContents Cel.Select 'Chez moi ça roule. Cel.Interior.ColorIndex = 15 msg_err = "" Else Cel = UCase(Cel) Cel.Interior.ColorIndex = xlNone End If
Si tu trouve pas dis un peu les références qui sont sélectionnées...
Dans l'IDE >> Outils >> Références et voir celles qui sont cochées.
A+

Voir 40 message(s) de cette discussion en une page