Sujet Précédent Sujet Suivant

Concatenation sous condition

Résolu
sokpassy85 Messages postés 64 Date d'inscription lundi 28 avril 2008 Statut Membre Dernière intervention 25 novembre 2014 - Modifié par sokpassy85 le 20/03/2014 à 09:52
jordane45 Messages postés 37726 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 27 septembre 2023 - 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

3 réponses

Réponse 1 / 3
jordane45 Messages postés 37726 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 27 septembre 2023 342
20 mars 2014 à 10:48
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.
0
Réponse 2 / 3
sokpassy85 Messages postés 64 Date d'inscription lundi 28 avril 2008 Statut Membre Dernière intervention 25 novembre 2014
20 mars 2014 à 11:16
Bonjour Jordane45,

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

Merci et àtrès bientôt.

--
0
Réponse 3 / 3
jordane45 Messages postés 37726 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 27 septembre 2023 342
20 mars 2014 à 11:56
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 :

0
sokpassy85 Messages postés 64 Date d'inscription lundi 28 avril 2008 Statut Membre Dernière intervention 25 novembre 2014
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.
0
jordane45 Messages postés 37726 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 27 septembre 2023 342
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
0

Discussions similaires

Concaténer 2 strings pour obtenir 1 string
cs_salazar -
crenaud76 -

3 réponses
PB entre '+' concatenation et '+' addition? comment j'additionne alors
rachidphp93 -
rachidphp93 -

5 réponses
concatenation 2variables et un saut de ligne
sabou94 -
malalam -

4 réponses
SQL Server : concatenation
aieeeuuuuu -
aieeeuuuuu -

8 réponses
test if dans une affectation
el_teedee -
Lutinore -

7 réponses
Rejoignez-nous