Extraire caractères VBA Résolu

Question

Bonjour, 


Je travaille en ce moment sur un code VBA mais je suis bloqué. Je souhaite comparer deux colonnes (B et C). Si un élément de la colonne C est présent sur la colonne B(en rouge), je dois extraire  les nombres qui se trouvent entre parenthèses sur l'a ligne de la colonne C sur la Feuil1. Certaines cellules sont vides.[



Merci d'avance pour votre aide

DjiDji59430 · Answer

Bonjour à tous,

Un debut de piste en formule !
mets le fichier, pas une photo !!!

https://www.cjoint.com/c/LAikqm4pyVY

Crdlmt

via55 · Answer

Bonjour 

Oui fournir le fichier aurait été plus utile, ainsi que de préciser où et sous quelle présentation extraire les nombres
Quoiqu'il en soit un exemple de code à adapter :
 https://www.cjoint.com/c/LAixlHMSWUg

Cdlmnt
Via

michel_m · Answer

Bonjour à tous

la solution par VBA sera différente suivant le nombre de lignes
donc, merci de nous le dire: 10? 1000? 10000 ?

moumousn · Answer

Super merci beaucoup à tout le monde 
via55 j'ai adapté et ça fonctionne  super merci 
J'ai juste un petit souci. Il ne faut pas que je relève le nombre si il est présent sur une autre ligne de la plage (si le nombre 17 est présent sur la 2eme ligne je ne dois pas le relever) 
Je n'arrive pas à ajouter ce paramètre

via55 · Answer

Il faut nettement modifier le code :
Sub extraction()
'dernière ligne remplie en col A
ligne = Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row
'boucle sur les lignes
For n = 1 To ligne
'si la valeur en col B se retrouve en col A (lorsque NB.SI(A:A;"*" & B1 & "*") = 1)
  If WorksheetFunction.CountIf(Range("A:A"), "*" & Range("B" & n) & "*") = 1 Then
  
  'dernière colonne remplie de la ligne en question
    Col = Rows(n).Find("*", , , , xlByRows, xlPrevious).Column
    'boucle sur les colonnes de la 5eme à la dernière remplie
        For g = 5 To Col
        ' chaine inscrite dans la cellule
        cel = Cells(n, g).Value
       
            'Boucle sur les caractères de la chaine depuis le 2nd jusqu'au dernier
         For t = 1 To Len(cel)
         'si le caractère est ( on recherche la position du  ) qui suit
         If Mid(cel, t, 1) = "(" Then
          np = InStr(t, cel, ")")
         
          'on extrait alors le nombre avec ses parenthèses
          nombre = Mid(cel, t, np - t + 1)
         
          's'il n'existe qu'en un seul exemplaire dans la plage E:K  (A ADAPTER) alors on supprime le ( et on remplace le ) par une , et on ajoute à la chaine extraite
           If WorksheetFunction.CountIf(Range("E1" & ": K" & ligne), "*" & nombre & "*") = 1 Then
            aj = WorksheetFunction.Substitute(WorksheetFunction.Substitute(nombre, "(", ""), ")", ",")
             ext = ext & aj
             End If
             
        End If
         Next t
        Next g
        'on inscrit en col D la chaine extraite moins son denier caractère (la dernière ,)
        Range("D" & n) = Left(ext, Len(ext) - 1)
        ' la chaine extraite est remise à vide pour la prochaine ligne
        ext = ""
    End If
Next
End Sub
Cdlmnt
Via

Extraire caractères VBA

5 réponses

Discussions similaires

Newsletters