Autres Résolu - Modification particulière dans des chaines de caracteres XL2007

eric57

XLDnaute Occasionnel
Bonjour le Forum.

Je reviens vers vous pour un soucis dont je n'arrive pas à trouver la solution.

Lors de transfert de listes d'appareils, des erreurs ont été enregistrés, ( dû au départ, à la présence d'espaces dans la cellule)

Je me retrouve avec des colonnes de 10.000 lignes avec parfois 3 ou 4000 erreurs

2 colonnes, dans la droite les "modèles" dans la gauche les "produits" . Dans la gauche, tout les produits doivent se terminer par une "/" et 2 chiffres.

Au moment du transfert, la barre "/" s'est parfois retrouvée en position 2 en partant de la droite. Du coup, dans la colonne de droite, un chiffre en trop est présent.

Je vous joint un fichier exemple, j'ai mis en jaune les cellules qui posent problèmes.

Merci d'avance a ceux qui pourrontme proposer une solution, toutes mes tentatives en VBA n'ont eu que des résultats mitigés ou partiels.
 

Pièces jointes

  • Transfere_liste.xlsx
    14.6 KB · Affichages: 7

Lolote83

XLDnaute Barbatruc
SAlut Eric57,
Pas sur d'avoir tout compris.
Faut-il modifier la colonne Modèle ou la colonne Produit ?
De ce que j'ai compris, c'est la colonne Modèle qui doit être la même que celle Produit - tous les caractères après le /.
Du coup, voir fichier joint.
@+ Lolote83
 

Pièces jointes

  • Copie de ERIC57 - Transfere_liste.xlsx
    11.6 KB · Affichages: 5

eric57

XLDnaute Occasionnel
Bonjour Lolote83

Merci pour ta réponse.

Non les 2 colonnes sont a modifier.
J'y arrive par le biais de formules mais cela me prend 4 colonnes a faire avec les formùules et ensuiote les copier-coller. D'ou ma demande si en VBA on ne pouvait pas faire quelque chose du genre :

Colonne "produit" :

si le "/" est à l'avant dernière position de la cellule, ( position 2 en partant de la droite ) alors je le met en position 3 (pour retrouver mes 2 chiffres après le "/")
et je supprime le dernier caractère de la colonne "modèle" de la même ligne.

@+
eric57
 

Lolote83

XLDnaute Barbatruc
Re salut,
Vite fait à la main et avant de cogiter à un code VBA, est-ce que cela devrait donner ca ?

1568126259622.png


Si oui, je pars sur cette idée demain pour codifier tout ça, si non, un exemple de ce que cela devrait donner pourra m'éclairer.
@+ Lolote83
 

sam8844

XLDnaute Nouveau
Bonsoir, à voir si avec une Regex dans la colonne NewProduit, et une formule dans la colonne NewModele ça peut aider, après c'est sûr qu'une macro serait plus rapide car Rechercher Remplacer avec les expressions régulières nécessite de l'ouvrir avec LibreOffice
 

Pièces jointes

  • Capture1.JPG
    Capture1.JPG
    102.4 KB · Affichages: 4
  • Capture2.JPG
    Capture2.JPG
    43 KB · Affichages: 3

Lolote83

XLDnaute Barbatruc
Re salut,
Finalement, j'ai un peu de temps.
Donc voici une macro qui tourne actuellement sur les 16 lignes
VB:
Sub Test_ERIC57()
    Application.ScreenUpdating = False
    xCpt = 0
    For Each xCell In Range("A2:B16")                           'Plage de cellules à traiter (à adapter)
        xCpt = xCpt + 1
        xLgr = Len(xCell.Value)
        Select Case xCpt
            '------------------------------------------------------------
            '                                           Traitement MODELE
            '------------------------------------------------------------
            Case Is = 1
                xDerCar = Right(xCell.Value, 1)
                If IsNumeric(xDerCar) = True Then               'Dernier caractère = numéro
                    xResult = Left(xCell.Value, xLgr - 1)
                Else                                            'Dernier caractère = lettre
                    xResult = xCell.Value
                End If
                xCol = "A"                                      'Lettre de la colonne ou seront inscrits les résultats Exemple : A=Colonne A (à adapter)
                
            '------------------------------------------------------------
            '                                          Traitement PRODUIT
            '------------------------------------------------------------
            Case Is = 2
                xPos = InStr(1, xCell.Value, "/")               'Cherche la position du / dans la chaine de caractères
                Select Case xLgr - xPos
                    Case Is = 1                                 'Si avant dernière position
                        xResult = Left(xCell.Value, xPos - 2) & "/" & Mid(xCell.Value, xPos - 1, 1) & Right(xCell.Value, 1)
                    Case Else                                   'Si autre position
                        xResult = xCell.Value
                End Select
                xCol = "B"                                      'Lettre de la colonne ou seront inscrits les résultats Exemple : B=Colonne B (à adapter)
                xCpt = 0                                        'On remet le compteur à 0
        End Select
        Range(xCol & xCell.Row) = xResult                       'On inscrit dans la colonne désignée le résultat
    Next xCell
    Application.ScreenUpdating = True
    MsgBox "TERMINE"
End Sub
Pour l'adapter à ton cas, il te faudra modifier 3 ou 4 trucs (voir instructions à adapter)
@+ Lolote83



 

Pièces jointes

  • Copie de ERIC57 - Transfere_liste.xlsm
    26.6 KB · Affichages: 3
  • Copie de ERIC57 - Transfere_liste.xlsm
    26.6 KB · Affichages: 2

eric57

XLDnaute Occasionnel
Bonsoir Lolote83

Je viens de mettre en place ta macro .

Après un certain temps ( voir même un temps certain) j'ai compris pourquoi elle ne marchait pas chez moi .. j'avais tjr ces P**** d'espaces dans la colonne "Codeproduit" à l'origine de mon problème. et du coup la macro ne pouvait pas afficher le bon résultat.

Par contre j'ai quand même un souci avec le "cas 1" traitement du "modèle", tu pars du principe que le dernier caractere doit être une lettre. Ce qui n'est pas tjr la cas, il se peut qu'on ai des chiffres.

Au final; le modèle est = au produit - les 3 derniers caractères ( 2 chiffres et le /)

Après avoir étudié ta macros, j'ai réussi à faire cela :

VB:
Sub Correction_Test() ' D'après Lolote83 sur Excel-Download
    Application.ScreenUpdating = False
    
    NP = Range("E" & Rows.Count).End(xlUp).Row
    
    xCpt = 0
    For Each xCell In Range("e2:E" & NP)                           'Plage de cellules à traiter (à adapter)
        xCpt = xCpt + 1
        xLgr = Len(xCell.Value)
        Select Case xCpt
          
            '------------------------------------------------------------
            '                                          Traitement PRODUIT
            '------------------------------------------------------------
            Case Is = 1
                xPos = InStr(1, xCell.Value, "/")               'Cherche la position du / dans la chaine de caractères
                Select Case xLgr - xPos
                    Case Is = 1                                 'Si avant dernière position
                        xResult = Left(xCell.Value, xPos - 2) & "/" & Mid(xCell.Value, xPos - 1, 1) & Right(xCell.Value, 1)
                    Case Else                                   'Si autre position
                        xResult = xCell.Value
                End Select
                xCol = "E"                                      ' Ma colonne Produit
                yCol = "D"                                       ' ma colonne Modele
                 xCpt = 0                             'On remet le compteur à 0

        End Select
        Range(xCol & xCell.Row) = xResult   'On inscrit dans la colonne désignée le résultat 
 
            '------------------------------------------------------------
            '                                          Traitement MODELE
            '------------------------------------------------------------
        yResult = Left(xResult, xLgr - 3)
        Range(yCol & xCell.Row) = yResult  
                
    Next xCell
    Application.ScreenUpdating = True
    MsgBox "TERMINE"
End Sub

et cela fonctionne bien
Merci pour ton aide
 

Lolote83

XLDnaute Barbatruc
Re salut Eric57,
Si jamais tu repasses par ici, voici un code beaucoup plus allégé rédigé en fonction de tes remarques au poste #10.
En espérant avoir bien compris la consigne
VB:
Sub Test_ERIC57_V2()
    Application.ScreenUpdating = False
    xErr = 0
    xDerLig = Range("B65000").End(xlUp).Row                         'On détermine la dernière ligne de la colonne B
    For Each xCell In Range("B2:B" & xDerLig)                       'On teste uniquement la colonne B (PRODUIT)
        xDecoupe = Split(xCell.Value, "/")
        If Len(xDecoupe(1)) = 1 Then
            xPremier = Left(xDecoupe(0), Len(xDecoupe(0)) - 1)      'On récupère la première partie
            xDernier = Right(xDecoupe(0), 1) & xDecoupe(1)          'On récupère la dernière partie
            Range("B" & xCell.Row) = xPremier & "/" & xDernier      'On inscrit dans la colonne désignée le résultat PRODUIT
            Range("A" & xCell.Row) = xPremier                       'On inscrit dans la colonne désignée le résultat MODELE
            xErr = xErr + 1                                         'On incrémente le compteur des erreurs
        End If
    Next xCell
    MsgBox "Traitement terminé : " & xErr & " erreurs ont été trouvées", vbInformation, "MODELE - PRODUIT"
    Application.ScreenUpdating = True
End Sub
@+ Lolote83
 

eric57

XLDnaute Occasionnel
Merci pour ton retour

Effectivement cela fonctionne bien sauf dans un cas. Il arrive parfois qu'une mauvaise info soit présente ( un mot sans le "/" ) ou bien qu'une cellule soit vide . DAns ce cas, la macros plante à la ligne " If Len(xDecoupe(1)) = 1 Then
 

Lolote83

XLDnaute Barbatruc
Re bonjour,
Serait-il possible d'avoir soit le fichier complet, soit un plus large échantillon pour pourvoir tester toutes les possibilités.
Il serait bien de mettre en évidence (avant diffusion du fichier) les quelques cas qui posent problèmes en plus de ceux récurrents.
Avec l'échantillon de 16 lignes (comme le fichier joint au début), ma macro fonctionne .....
@+ Lolote83
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof