Concatenation sous condition [Résolu]

sokpassy85 64 Messages postés lundi 28 avril 2008Date d'inscription 25 novembre 2014 Dernière intervention - 20 mars 2014 à 09:42 - Dernière réponse : jordane45 22944 Messages postés mercredi 22 octobre 2003Date d'inscriptionModérateurStatut 23 octobre 2018 Dernière intervention
- 20 mars 2014 à 12:50
Bonjour MMesdames, Messieurs,

Je souhaite votre aide.
J'ai un tableau sous excel de 3 colonnes comme suit:
TU1 |TU1|54B
DM1|TU1|35R
Cb3|GA4|54C
.. |... |...

Je souhaite une macro pour faire comme suit:

TU1 |TU1|54B|54B, 35R|
DM1|TU1|35R
Cb3|GA4|54C
.. |... |...
Je m'explique: si la contenue de la cellule ("A2") se trouve dans la colonne ("B:B"), si on trouve la valeur de ("A2") plusieurs dans ("B:B"), on concetne les contenues correspondantes de la colonne ("C:C") dans la colonne ("E:E"). Si on la trouve une seule fois, on copie la valeur de ("C") dans ("E") à la ligne correspondante.
Sachant la colonne ("A:A") est de taille plus petite que celles de ("B:B") et ("C:C").

Voici le code que j'ai commencé à faire et il ne marche pas correctement.


Sub concatener2()
Dim concatene As String
Dim valCell As String
Dim valRef As String
Dim valRefSuiv As String
Dim valFolio As String
Dim valFolioSuiv As String
Dim k As Integer
Dim j As Integer
Dim y As Integer
Dim n As Integer
valFolio = ""
'------------------------------------------------
' Boucle sur l'ensemble de ta plage de cellules
'------------------------------------------------
For k = 2 To 6000 'Range("A65536").End(xlUp).Row
valCell = Cells(k, "A").Value
Cells(k, "A").Select
k = k + 1
For y = 2 To 6000
valRef = Cells(y, "B").Value
valRefSuiv = Cells(y + 1, "B").Value
If valRef = valCell Then
valRefSuiv = Cells(y + 1, "B").Value
Cells(y, "B").Select
y = y + 1
j = y
For j = 2 To 6000
valFolio = Cells(j, "C").Value
valFolioSuiv = Cells(j + 1, "C").Value
'If valFolioSuiv = valFolio Then

valFolio = concatene

'*********************************************************
Debug.Print "valCell " & valCell
Debug.Print "valRef " & valRef
Debug.Print "valRefSuiv " & valRefSuiv
Debug.Print "valFolio " & valFolio
Debug.Print "valFolioSuiv " & valFolioSuiv

'---------------------------------------------------------
' Si valeur cellule actuelle <> de la valeur précédente
'---------------------------------------------------------


If valFolioSuiv <> valRef And valCell = valRef Then
j = y
'---------------------------------------------------------
' Boucle sur les cellules de même valeur
'---------------------------------------------------------

While valRefSuiv = Cells(j + 1, "B").Value
If valRefSuiv = Cells(j + 1, "B") Then

concatene = concatene & "," & Chr(10) & valFolioSuiv
Else
Exit For
End If
j = j + 1
Wend
End If


Cells(y, "E").Value = concatene
valFolio = valCell
'End If
Next j
End If
Next y
Next k

End Sub

Sub concatene3()
Dim i As Integer
Dim concaten As Variant
Dim n As Integer
n = 2
For n = 2 To 6000 'Range("A65536").End(xlUp).Row

concatene = Range("E" & n)
For i = 2 To 6000
If Cells(i, 1).Value = Cells(i, 2).Value Then
concantene = concatene & "/" & Range("E" & n)
End If
Next i
Next n
End Sub

Merci de votre aide
Afficher la suite 

Votre réponse

5 réponses

jordane45 22944 Messages postés mercredi 22 octobre 2003Date d'inscriptionModérateurStatut 23 octobre 2018 Dernière intervention - 20 mars 2014 à 10:48
0
Merci
Bonjour,

Je pense que pour faire ce que tu souhaites tu pourrais utiliser une méthode de type FINDALL.

Function FindAll(ByVal sText As String, ByRef oSht As Worksheet, ByRef sRange As String, ByRef arMatches() As String) As Boolean
' --------------------------------------------------------------------------------------------------------------
' FindAll - To find all instances of the1 given string and return the row numbers.
' If there are not any matches the function will return false
' --------------------------------------------------------------------------------------------------------------
On Error GoTo Err_Trap
Dim rFnd As Range ' Range Object
Dim iArr As Integer ' Counter for Array
Dim rFirstAddress ' Address of the First Find
' -----------------
' Clear the Array
' -----------------
Erase arMatches
Set rFnd = oSht.Range(sRange).Find(what:=sText, LookIn:=xlValues, lookAt:=xlPart)

If Not rFnd Is Nothing Then
rFirstAddress = rFnd.Address
Do Until rFnd Is Nothing
iArr = iArr + 1
ReDim Preserve arMatches(iArr)
arMatches(iArr) = rFnd.Row 'rFnd.Address pour adresse complete ' rFnd.Row Pour N° de ligne
Set rFnd = oSht.Range(sRange).FindNext(rFnd)
If rFnd.Address = rFirstAddress Then Exit Do ' Do not allow wrapped search
Loop
FindAll = True
Else
' ----------------------
' No Value is Found
' ----------------------
FindAll = False
End If
' -----------------------
' Error Handling
' -----------------------
Err_Trap:
If Err <> 0 Then
MsgBox Err.Number & " " & Err.Description, vbInformation, "Find All"
Err.Clear
FindAll = False
Exit Function
End If
End Function


Exemple d'utilisaiton :
Sub Exemple_util_Findall()

Dim arTemp() As String 'variable tableau pour la fonction Findall
Dim ValCherchee as string
ValCherchee="test"
Dim Nom_Feuil as string
Nom_Feuil = "Feuil1"

'---------------------------------------------------------------
bFound = FindAll(ValCherchee, Sheets(Nom_Feuil), ma_plage, arTemp())
'---------------------------------------------------------------

If bFound = True Then
Debug.Print "Nb occurences : " & UBound(arTemp)
For X = 1 To UBound(arTemp)
debug.print arTemp(X)
Next
End If

End sub



Donc pour ton besoin, en gros, tu boucles sur ta colonne A.
Pour chaque valeur de la colonne A tu cherches si elle existe dans la colonne B avec la méthode FIND.
-> Puis tu boucles sur le tableau retourné par la méthode FIND pour récupérer les valeurs trouvées et les copier dans ta colonne C.
Voilou.

Je te laisse appréhender cette fonction et essayer de créer ton code.
Commenter la réponse de jordane45
sokpassy85 64 Messages postés lundi 28 avril 2008Date d'inscription 25 novembre 2014 Dernière intervention - 20 mars 2014 à 11:16
0
Merci
Bonjour Jordane45,

C'est gentil de votre part. Je vais essayer et je vous ferai un retour.

Merci et àtrès bientôt.

--
Commenter la réponse de sokpassy85
jordane45 22944 Messages postés mercredi 22 octobre 2003Date d'inscriptionModérateurStatut 23 octobre 2018 Dernière intervention - 20 mars 2014 à 11:56
0
Merci
Dis moi si ça te conviens :
( En ajoutant dans un module la fonction FINDALL que je t'ai donné juste avant..)

Sub ConcatRJ()
'------------------------------------------------------
' Tableau contenant la liste des lignes trouvées
' par la méthode findAll()
'------------------------------------------------------
Dim arTemp() As String
'------------------------------------------------------
' Autres variables :
'------------------------------------------------------
Dim nomF As String
    nomF = "Feuil1"
Dim PlageRecherche As String
    PlageRecherche = "B1:B6"
Dim MaRange As Range
    Set MaRange = Range("A1:A6")
Dim concat As String


'------------------------------------------------------
' Début du traitement :
'------------------------------------------------------
'On parcourt la colonne A
For Each cell In MaRange
     ValCherchee = cell.Value
     ligneCell = cell.Row
     concat = ""
    If ValCherchee <> "" Then
        '---------------------------------------------------------------
            bFound = FindAll(ValCherchee, Sheets(nomF), PlageRecherche, arTemp())
        '---------------------------------------------------------------
        Debug.Print "Ligne: " & ligneCell & " : " & ValCherchee & " ---> " & bFound
        If bFound = True Then
            Debug.Print "Nb occurences : " & UBound(arTemp)
            For X = 1 To UBound(arTemp)
                Debug.Print "-------> trouvé Ligne : " & arTemp(X)
                ' * Ici mettre le code pour la concaténation
                concat = concat & "," & Cells(arTemp(X), "C").Value
            Next
             '* Ici : Code pour copier les valeurs trouvées dans la colonne E
             Cells(ligneCell, "D").Value = Right(concat, Len(concat) - 1)
        End If
    End If
Next
End Sub



Ce qui donne :

sokpassy85 64 Messages postés lundi 28 avril 2008Date d'inscription 25 novembre 2014 Dernière intervention - 20 mars 2014 à 12:27
Merci Jordane45. Ca marche très bien. Un petit problème sur la première, on a 35R,54B,35R,54B. Il le répéte deux fois. Je crois que je pourrai remédier ce problème.

Mon problème est résolut. Je vous remercie beaucoup. C'est très gentil et j'en suis reconnaissant.

A ^la prochaine.
jordane45 22944 Messages postés mercredi 22 octobre 2003Date d'inscriptionModérateurStatut 23 octobre 2018 Dernière intervention - 20 mars 2014 à 12:50
Mon problème est résolu.
Donc.... pensez à clore la discussion en cliquant sur le lien : Marquer comme résolu
Commenter la réponse de jordane45

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.