Discussion :

[goldfinger13]

Bonsoir à tous,
je reviens vers vous car je patauge un peu.
Je travaille sur un fichier à 25000 lignes
En colonne AV j'ai les trois caractères à comparer avec mes variables case1 et 2
le raisonnement est le suivant:
si la valeur de la case AV1 est inférieur à la valeur de case1 alors la valeur de AY1 est égale à "CASE A à AOU" etc...

j'ai tenté le code suivant mais bien évidement celà ne fonctionne pas. Pouvez vous m'aider?

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
Sub TGB()
 'determination derniere ligne non vide du tableau
Dim derLig As Long
derLig = [A65000].End(xlUp).Row
Dim case1 As String
Dim case2 As String
case1 = "AOU"
case2 = "AUR"
'
 For i = 2 To derLig
        Select Case Range("AV" & i)
            Case Is < case1
                Range("AY" & i) = "CASE A à AOU"
             Case Is < case2
                Range("AY" & i) = "CASE APO à AUR"
.........
.......
        End Select
    Next i
 
 End Sub

[Philippe Tulliez]

Bonjour,
Dans ton code, tu compares deux chaînes de caractères. Le contenu de la cellule "AV" & I (N° de la ligne) et deux variables nommées Case1 & Case2.
Les noms sont déjà ambigus parce-que tellement proche de l'instruction Select Case.
Ensuite si le test est positif tu place dans une cellule "AY" & la même ligne une chaîne de caractères "CASE A à AOU" ou "CASE APO à AUR" que je devine être autre chose qu'une chaîne de caractères mais plutôt des références à des colonnes.
Que tu expliques par :

En colonne AV j'ai les trois caractères à comparer avec mes variables case1 et 2
le raisonnement est le suivant:
si la valeur de la case AV1 est inférieur à la valeur de case1 alors la valeur de AY1 est égale à "CASE A à AOU" etc...

Et là, j'avoue ne pas comprendre. Que voudrais-tu placer dans la cellule AY1 ?
Tout de même pas les contenus des cellules A1 à AOU1.
A moins que ce ne soit la somme des cellules A1 à AOU1?

[goldfinger13]

Re bonsoir
dans la colonne AV j'ai les trois premières lettres d'un mot situé dans une autre colonne.
Pour la compréhension j'ai modifié le nom des variables: groupe au lieu de case (plus lisible)
le résultat attendu en colonne AY: je veux grouper sous le terme " BLOC A à AOU" tous les mots dont les trois premieres lettres sont comprises entre AAA et AOU ainsi de suite pour groupe 2, 3 etc. Par bloc je devrais me retrouver avec 37 lignes en moyenne. Ensuite j'utiliserai ce regroupement dans un TCD.

Dans le fichier exemple joint la colonne AV de ma base est représentée en colonne B
le résultat est en colonne E au lieu de AY dans ma base.

J’espère que ce sera plus clair avec la pièce jointe

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
Sub TGB()
 'determination derniere ligne non vide du tableau
Dim derLig As Long
derLig = [A65000].End(xlUp).Row
Dim GROUPE1 As String
Dim GROUPE2 As String
GROUPE1 = "AOU"
GROUPE2 = "AUR"
'
 For i = 2 To derLig
        Select Case Range("B" & i)
            Case Is < GROUPE1
                Range("E" & i) = "BLOC A à AOU"
             Case Is < GROUPE2
                Range("E" & i) = "BLOC APO à AUR"
.........
.......
        End Select
    Next i
 
 End Sub

[mercatog]

Bonsoir

Code applicable sur ton fichier test (à adapter à ton fichier réel)

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
Sub TGB()
Dim LastLig As Long, i As Long
Dim Code As String
Dim j As Byte
Dim Deb, Fin, Inp, Oup() As String
 
'Les 2 tableaux doivent être trié par ordre croissant
Deb = Array("A", "APO", "B", "Z") 'Z en fin est nécessaire
Fin = Array("AOU", "AVR", "BEN", "ZZZ") 'ZZZ en fin est nécessaire
Application.ScreenUpdating = False
With Sheets("Feuil1")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    Inp = .Range("B2:B" & LastLig).Value
    ReDim Oup(1 To LastLig - 1, 1 To 1)
    For i = 1 To LastLig - 1
        Code = Trim(UCase(Inp(i, 1)))
        For j = 0 To UBound(Deb)
            If StrComp(Code, Deb(j), 1) < 0 Then Exit For
        Next j
        Oup(i, 1) = "BLOC " & Deb(j - 1) & " à " & Fin(j - 1)
    Next i
    .Range("E2:E" & LastLig).Value = Oup
End With
End Sub

[goldfinger13]

je suis impressionné!
Pourrais tu me donner quelques explications afin que je puisse l'adapter à mon fichier.
D'ores et déjà merci pour ton aide.

si je comprends bien les deux tableaux servent à délimiter les bornes des blocs?

[mercatog]

J'ai revu légèrement le code et j'ai mis des commentaires. les lignes dont les commentaires sont précédés par ** sont à adapter:

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
Sub TGB()
Dim LastLig As Long, i As Long
Dim Code As String
Dim j As Byte
Dim Deb, Fin, Inp
 
'Les 2 tableaux doivent être trié par ordre croissant
'**Debut des blocs
Deb = Array("A", "APO", "B", Chr(255)) 'Chr(255) en fin est nécessaire
'**Fin des blocs
Fin = Array("AOU", "AVR", "BEN")
'Inhibe la mise à jour afficahe écran
Application.ScreenUpdating = False
'** adapte au nom de ta feuille
With Sheets("Feuil1")
    '**N° de ligne de la dernière cellule remplie de la colonne A
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    '**Inp: Tableau contenant l'ensemble des cellules à 3 lettre ici en colonne B
    Inp = .Range("B2:B" & LastLig).Value
    'on boucle sur les éléments du tableau Inp
    For i = 1 To LastLig - 1
        'Chaque élément du teableau
        Code = Trim(UCase(Inp(i, 1)))
        'On boucle sur le tableau jusqu'à ce que Code soit inférieur à l'élément de Deb et on sort
        For j = 0 To UBound(Deb)
            If StrComp(Code, Deb(j), vbTextCompare) < 0 Then Exit For
        Next j
        'on revient vers l'élément précédent et on remplie le tableau Inp
        Inp(i, 1) = "BLOC " & Deb(j - 1) & " à " & Fin(j - 1)
    Next i
    '**On transfert le tableau Inp vers la colonne E
    .Range("E2:E" & LastLig).Value = Inp
End With
End Sub