IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Fonction FIND avec plusieurs valeurs dans une meme cellule. [Toutes versions]


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre averti
    Homme Profil pro
    Étudiant
    Inscrit en
    Juin 2015
    Messages
    54
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Suisse

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : Juin 2015
    Messages : 54
    Par défaut Fonction FIND avec plusieurs valeurs dans une meme cellule.
    Bonjour a tous,

    Je suis bloque sur un code:
    La situation:
    1. le code ci dessous check les valeures dans la colonne A de la feuille2 et check si il y a une correspondance dans la colonneA de la feuille1. Si oui alors la ligne de la feuille2 est copier puis coller dans la ligne correspondante de la feuille1.

    Le probleme: J'ai plusieurs code dans la meme cellule qui sont separe par des virgules. Il y a t'il un moyen avec VBA pour que le code check tout les codes dans une meme cellule (dans la Feuille2) et check dans la feuille1.

    J 'ai essaye d'utilise SPLIT mais je n'y arrive pas. Je suis preneur de toutes idees.

    Thanks a lot!

    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
    Option Explicit
    Sub ReplaceData()
     
    Dim lastRw1, lastRw2, nxtRw, m
     
    'Determine last row with data, Sheet1
      lastRw1 = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row 'Determine last row with data, Sheet2
      lastRw2 = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row 'Loop through Sheet 2, Column A
     
         For nxtRw = 2 To lastRw2
     
    'Search Sheet1 Column A for value from Sheet 2
            With Sheets(1).Range("A2:A" & lastRw1)
              Set m = .Find(Sheets(2).Range("A" & nxtRw), LookAt:=xlWhole) 'Copy Sheet2 row if match is found
     
                If Not m Is Nothing Then
                  Sheets(2).Range("A" & nxtRw).EntireRow.Copy _
                  Sheets(1).Range("A" & m.Row)
     
                End If
     
            End With
         Next
     
    End Sub

  2. #2
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    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
    Sub ReplaceData()
    Dim LastRw1 As Long, LastRw2 As Long, NxtRw As Long
    Dim i As Integer
    Dim m As Range
    Dim Tb
     
    LastRw1 = Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row
     
    With Worksheets(2)
        LastRw2 = .Range("A" & Rows.Count).End(xlUp).Row
        For NxtRw = 2 To LastRw2
            Tb = Split(.Range("A" & NxtRw), ",")
            For i = 0 To UBound(Tb)
                With Sheets(1).Range("A2:A" & LastRw1)
                    Set m = .Find(Tb(i), LookAt:=xlWhole)
                    If Not m Is Nothing Then
                        .Range("A" & NxtRw).EntireRow.Copy Sheets(1).Range("A" & m.Row)
                        Set m = Nothing
    'Exit For 'éventuellement
                    End If
                End With
            Next i
        Next NxtRw
    End With
    End Sub

  3. #3
    Membre averti
    Homme Profil pro
    Étudiant
    Inscrit en
    Juin 2015
    Messages
    54
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Suisse

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : Juin 2015
    Messages : 54
    Par défaut
    Bonjour,
    Tout abord un grand merci, votre amelioration m'a fait avancé d'un grand pas.

    Néanmoins il a toujours un petit soucis que je n'avais peut être pas précisé.

    Si dans la sheet1 il y a:

    MDM-123,MDM-321
    Et dans la sheet2:

    MDM-321
    Le code ne trouve pas la correspondance et donc ne copie/colle pas la ligne en question.

    Est-ce possible de rajouter une loop qui demande au code de regarder chaque string a l'intérieur de chaque cellule dans la sheet1?

    Au sinon c'est exactement ce que je recherche a faire!
    Loop VBA.xlsm
    Merci de votre aide!!

  4. #4
    Expert confirmé
    Homme Profil pro
    Inscrit en
    Août 2010
    Messages
    3 453
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : Août 2010
    Messages : 3 453
    Par défaut
    Bonjour,

    Remplace la ligne :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
     
    Set m = .Find(Tb(i), LookAt:=xlWhole)
    du code de mercatog par cette ligne :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
     
    Set m = .Find(Tb(I), LookAt:=xlPart)
    Hervé.

  5. #5
    Membre averti
    Homme Profil pro
    Étudiant
    Inscrit en
    Juin 2015
    Messages
    54
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Suisse

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : Juin 2015
    Messages : 54
    Par défaut
    Merci beaucoup Hervé!!!

    Juste serait il possible de garder les tout les strings d'une seule cell dans la colonneA sheet1. Car avec cette ligne cela garde que la ou les strings de la sheet2.

    Je veux dire par la:

    Sheet1 colonneA:

    MDM-123,MDM-321

    Sheet2 colonneA:

    MDM-321

    Du coup mon ideal serait de garder: MDM-123,MDM-321 dans la sheet1 colonneA


    Merci d'avance!

    Manu

  6. #6
    Expert confirmé
    Homme Profil pro
    Inscrit en
    Août 2010
    Messages
    3 453
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : Août 2010
    Messages : 3 453
    Par défaut
    Bonjour,

    Sans trop de tests, je verrai cela comme ça :
    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
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
     
    Sub Test()
     
        Dim PlageFe1 As Range
        Dim PlageFe2 As Range
        Dim CelFe1 As Range
        Dim CelFe2 As Range
        Dim Tb
        Dim I As Integer
        Dim DerCol As Long
     
        With Worksheets(1)
     
            Set PlageFe1 = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
     
        End With
     
        With Worksheets(2)
     
            Set PlageFe2 = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
            DerCol = .Cells(1, Columns.Count).End(xlToLeft).Column
     
        End With
     
        For Each CelFe2 In PlageFe2
     
            Tb = Split(CelFe2.Value, ",")
     
            For I = 0 To UBound(Tb)
     
                Set CelFe1 = PlageFe1.Find(Tb(I), , xlValues, xlPart)
     
                If Not CelFe1 Is Nothing Then
     
                    PlageFe1.Range(PlageFe1.Cells(CelFe1.Row, 2), PlageFe1.Cells(CelFe1.Row, DerCol)).Value = _
                    PlageFe2.Range(PlageFe2.Cells(CelFe2.Row, 2), PlageFe2.Cells(CelFe2.Row, DerCol)).Value
     
                    Set CelFe1 = Nothing
     
                End If
     
            Next I
     
        Next CelFe2
     
    End Sub
    Hervé.

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [XL-2010] Dans une fonction, comment tester plusieurs valeurs d'une seule cellule
    Par yzf-r dans le forum Macros et VBA Excel
    Réponses: 7
    Dernier message: 23/08/2011, 11h09
  2. Plusieurs valeurs dans une même cellule
    Par biche1 dans le forum Excel
    Réponses: 4
    Dernier message: 25/09/2008, 15h56
  3. Réponses: 5
    Dernier message: 04/06/2008, 10h03
  4. Réponses: 3
    Dernier message: 20/02/2008, 17h13
  5. [VBA-E]Mise en place de 2 valeurs dans une meme cellule
    Par baptbapt dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 25/08/2006, 15h06

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo