XL 2013 Lenteur d'exécution

[Barney62]

Bonjour,
J'ai un fichier de plus de 10000 lignes dans lesquelles j'ai besoin de vérifier dans une colonne un mot particulier et si c'est le cas, mettre un nom en face dans une autre colonne. Seulement ce n'est pas un mot à vérifier mais 9 mots que je vérifie pour les classer ensuite par groupe. Ma programmation fonctionne mais elle est est lente. Y a t il une solution plus efficace?
Le fichier et le code joint ne sont qu'un un exemple compte tenu de la confidentialité du mien. J'espère que j'ai pu me faire comprendre.
Merci d'avance

Option Explicit
Dim numeroLigne As Integer
Dim i As Integer
Public Sub Extraction()
Application.ScreenUpdating = False
'Calcul du nombre de lignes remplies
numeroLigne = Range("C30000").End(xlUp).Row
'Comparaison ABC et DEF
    For i = 2 To numeroLigne
        If Cells(i, 3) Like "*1*ABC*" Then
        Cells(i, 2) = "1e ABC"
        ElseIf Cells(i, 3) Like "*2*ABC*" Then
        Cells(i, 2) = "2e ABC"
        ElseIf Cells(i, 3) Like "*3*ABC*" Then
        Cells(i, 2) = "3e ABC"
        ElseIf Cells(i, 3) Like "*4*ABC*" Then
        Cells(i, 2) = "4e ABC"
        ElseIf Cells(i, 3) Like "*5*ABC*" Then
        Cells(i, 2) = "5e ABC"
        ElseIf Cells(i, 3) Like "*6*ABC*" Then
        Cells(i, 2) = "6e ABC"
        ElseIf Cells(i, 3) Like "*10*DEF*" Then
        Cells(i, 2) = "10e DEF"
        ElseIf Cells(i, 3) Like "*11*DEF*" Then
        Cells(i, 2) = "11e DEF"
        Else: Cells(i, 2) = "12e DEF"
       End If
'Comparaison Groupe 1 et Groupe 2
        If Cells(i, 2) Like "*ABC" Then
        Cells(i, 1) = "Groupe 1"
        Else: Cells(i, 1) = "Groupe 2"
        End If
    Next
   Application.ScreenUpdating = True
End Sub

 

[patoq]

Bonjour,

A essayer pour voir si cela est plus rapide ( 4 s chez moi avec 10000 lignes)

Dim numeroLigne As Integer
Dim mavaleur As String
Dim i As Integer
Public Sub Extraction()
Application.ScreenUpdating = False
'Calcul du nombre de lignes remplies
numeroLigne = Range("C30000").End(xlUp).Row
'Comparaison ABC et DEF
    For i = 2 To numeroLigne
  
    mavaleur = Cells(i, 3)
  
    Select Case True
  
    Case mavaleur Like "*1*ABC*": Cells(i, 2) = "1e ABC"
    Case mavaleur Like "*2*ABC*": Cells(i, 2) = "2e ABC"
    Case mavaleur Like "*3*ABC*": Cells(i, 2) = "3e ABC"
    Case mavaleur Like "*4*ABC*": Cells(i, 2) = "4e ABC"
    Case mavaleur Like "*5*ABC*": Cells(i, 2) = "5e ABC"
    Case mavaleur Like "*6*ABC*": Cells(i, 2) = "6e ABC"
    Case mavaleur Like "*10*DEF*": Cells(i, 2) = "10e DEF"
    Case mavaleur Like "*11*DEF*": Cells(i, 2) = "11e DEF"
    Case mavaleur Like "*12*DEF*": Cells(i, 2) = "12e DEF"
  
    End Select
'Comparaison Groupe 1 et Groupe 2
        If Cells(i, 2) Like "*ABC" Then
        Cells(i, 1) = "Groupe 1"
        Else: Cells(i, 1) = "Groupe 2"
        End If
    Next
   Application.ScreenUpdating = True
End Sub

 

[vgendron]

Hello

un essai avec ce code

Option Explicit
Dim numeroLigne As Integer
Dim i As Integer
Dim strToTest As String
Public Sub Extraction()
Application.ScreenUpdating = False
'Calcul du nombre de lignes remplies
numeroLigne = Range("C" & Rows.Count).End(xlUp).Row
'Comparaison ABC et DEF

For i = 2 To numeroLigne
    strToTest = Cells(i, 3)
    Select Case True
        Case strToTest Like "*1*ABC*"
            Cells(i, 2) = "1e ABC"
            Cells(i, 1) = "Groupe 1"
                  
        Case strToTest Like "*2*ABC*"
            Cells(i, 2) = "2e ABC"
            Cells(i, 1) = "Groupe 1"
                  
        Case strToTest Like "*3*ABC*"
            Cells(i, 2) = "3e ABC"
            Cells(i, 1) = "Groupe 1"
                  
        Case strToTest Like "*4*ABC*"
            Cells(i, 2) = "4e ABC"
            Cells(i, 1) = "Groupe 1"
              
        Case strToTest Like "*5*ABC*"
            Cells(i, 2) = "5e ABC"
            Cells(i, 1) = "Groupe 1"
      
        Case strToTest Like "*6*ABC*"
            Cells(i, 2) = "6e ABC"
            Cells(i, 1) = "Groupe 1"
          
        Case strToTest Like "*10*DEF*"
            Cells(i, 2) = "10e DEF"
            Cells(i, 1) = "Groupe 2"
        
        Case strToTest Like "*11*DEF*"
            Cells(i, 2) = "11e DEF"
            Cells(i, 1) = "Groupe 2"
          
        Case Else
            Cells(i, 2) = "12e DEF"
            Cells(i, 1) = "Groupe 2"
    End Select
Next i
Application.ScreenUpdating = True
End Sub

Hello Patoq , je vois qu'on a eu la meme idée

 

[Dranreb]

Bonjour.
Perso, je l'aurais probablement écrit comme ça :

Option Explicit
Public Sub Extraction()
Dim TE(), TS(), L As Long, N As Long
TE = [SGL_5_SGL7[Descripttion]].Value
ReDim TS(1 To UBound(TE, 1), 1 To 2)
For L = 1 To UBound(TE, 1)
   If TE(L, 1) Like "*#*ABC*" Then
      For N = 1 To 6: If TE(L, 1) Like "*" & N & "*ABC*" Then Exit For
          Next N: If N <= 6 Then TS(L, 2) = N & "e ABC"
   ElseIf TE(L, 1) Like "*10*DEF*" Then
         TS(L, 2) = "10e DEF"
   ElseIf TE(L, 1) Like "*11*DEF*" Then
         TS(L, 2) = "11e DEF"
   Else: TS(L, 2) = "12e DEF": End If
   TS(L, 1) = "Groupe " & 2 + (Right$(TS(L, 2), 3) = "ABC")
   Next L
[SGL_5_SGL7[[Groupe]:[Entité]]].Value = TS
End Sub

 

[Barney62]

Bonsoir,
Je suis quelqu'un qui connait un peu excel mais j'essaye de m'améliorer. Donc merci à tous pour les réponses.
Je ne connaissais pas la fonction Select Case. Cela évite d'utiliser les ELSEIF. Je testerai cela au boulot la semaine prochaine.
Pour Dranreb, j'ai un peu de mal à saisir. Mais je vais essayer de comprendre. Je ne sais pas si cela fonctionnera car dans mon fichier réel ce n'est pas 1, 2,3,....6 ABC mais 2, 3, 4, 6 ,7, 8 ABC. Ce que je veux dire c'est que les chiffres ne sont pas incrémentés de 1 (en fait il n'y a pas de 1 ni de 5). Pour les DEF c'est 12, 13 et 14.
Encore merci

 

[Dranreb]

Si ça ne va pas vous re-détaillerez. L'essentiel c'est d'utiliser les tableaux TE et TS. C'est bien d'un problème de lenteur que vous vous plainiez, non ? Là ce sera instantané.

 

[Barney62]

Merci Draneb
Effectivement c'est très rapide.
J'avoue n'avoir pas très bien compris cette ligne :
TS(L, 1) = "Groupe " & 2 + (Right$(TS(L, 2), 3) = "ABC")
Compte tenu que ce n'est groupe 1 ou 2 que je dois mettre mais deux noms différents; alors j'ai adapté comme suit :
if TS(L,2) Like "*ABC" Then TS(L,1)="Titi" Else TS(L,1)="Toto"
Je viens d'apprendre beaucoup sur le fonctionnement des tableaux.
Merci encore

 

[Dranreb]

Right$(TS(L, 2), 3) = "ABC" est une condition, True ou False.
Impliquée dans une addition sa représentation en mémoire est prise en tant que nombre. True, ayant tous ses bits à 1, revient à -1, contrairement à Excel qui assume VRAI = 1 dans un cas semblable. Ça fait donc 2 si la condition est fausse, et 2 + -1, soit 2 - 1, soit 1 si elle est vraie.
Mais vous avez fait autre chose conformément à un autre vrai besoin. Très bien.

 

[Barney62]

Merci pour cette explication