Concatèner à l'aide d'une macro

Signaler
Messages postés
64
Date d'inscription
lundi 28 avril 2008
Statut
Membre
Dernière intervention
25 novembre 2014
-
Messages postés
64
Date d'inscription
lundi 28 avril 2008
Statut
Membre
Dernière intervention
25 novembre 2014
-
Bonjour,

Je souhaiterai de l'aide pour faire ceci (voir image ci-dessous) à l'aide d'une macro.
Je devrai pouvoir le faire grâce à me historiques mais faute de temps et démuni en matière code, je sollicite votre aide pour arriver à bout ce sujet. Je dois faire ça sur un tableau de 32.000 lignes environ.

Je vous remercie d'avance et merci de votre compréhension.



--

6 réponses

Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
240
Bonjour,
Je comprends bien qu'il te manque du temps et que tu es "démuni en matière de code"...
Le temps est précieux pour tous, ici, y compris pour les bénévoles, qui ne sont pas là pour écrire ton code, mais pour t'aider, au besoin, à l'écrire. Si tu viens ici, c'est que tu es un développeur.
Commence donc par nous montrer au moins ce que tu as tenté d'écrire. Et ce d'autant que ce n'est pas compliqué.
Messages postés
16541
Date d'inscription
mardi 11 mars 2003
Statut
Modérateur
Dernière intervention
28 novembre 2021
577
Bonjour, en complément de ce que dit Uc (que je salue au passage), si vraiment tu ne sais pas ou commencer, il existe l'outil "Enregistrer une Macro" qui est souvent un bon point de départ.


Penser aux balises de coloration syntaxique: bouton <>, préciser le langage :<code csharp>.
Quand la solution est trouvée, mettre la discussion Résolue.
Messages postés
34172
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
28 novembre 2021
357
Sans oublier que des sujets identiques ont déjà été traité sur ce forum.

Messages postés
64
Date d'inscription
lundi 28 avril 2008
Statut
Membre
Dernière intervention
25 novembre 2014

Bonjour,

Vous avez tout a fait raison, j'y suis sauf que pour l'instant il ne ressemble à rien car ne fait rien du tout à part me générer des erreurs. Je suis parti sur mes précédents sujets pour faire un outil qui marche.

Ci-dessous le code (repris de mes précédents sujets). Je souhaiterai qu'il concatène jusqu'à rencontrer une nouvelle en gras. En ce moment il recopie uniquement le contenu de la première cellule.

Je vous remercie d'avance.


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
Sub Conc()
'------------------------------------------------------
' Tableau contenant la liste des lignes trouvées
' par la méthode findAll()
'------------------------------------------------------
Dim arTemp() As String
'------------------------------------------------------
' Autres variables :
'------------------------------------------------------
Dim nomF As String
Dim n As Integer
nomF = "CODE_DTR"
Dim PlageRecherche As String
PlageRecherche = "C2:C30000"
Dim MaRange As Range
Set MaRange = Range("A2:A30000")
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 & "," & Chr(10) & Cells(arTemp(X) + 1, "C").Value



Next

'* Ici : Code pour copier les valeurs trouvées dans la colonne E
If Cells(ligneCell, "C").Value <> "" Then
Cells(ligneCell, "B").Value = Right(concat, Len(concat) - 1)
Cells(ligneCell, "B").Select

End If

End If
End If
Next


--
Messages postés
64
Date d'inscription
lundi 28 avril 2008
Statut
Membre
Dernière intervention
25 novembre 2014

Bonjour,

vous avez raison, merci beaucoup pour vos coups de pouce.
Messages postés
64
Date d'inscription
lundi 28 avril 2008
Statut
Membre
Dernière intervention
25 novembre 2014

Bonjour,
Bonjour, j'ai réussi récupérer une partie des données. Maintenant je souhaiterai mettre en place une boucle qui me permet une fois la valeur de la colonne est trouvée dans la colonne C (en gras) de concaténer les cellules qui sont en dessous de celle ci jusqu'à la prochaine cellule en gras.
J'ai essayé ce code mais ça ne marche pas. Merci de votre aide.

For X = 1 To UBound(arTemp)
While Cells(arTemp(X), "C").Font.Bold = False

Debug.Print "-------> trouvé Ligne : " & arTemp(X)
' * Ici mettre le code pour la concaténation
If Cells(arTemp(X), "C").Value = ValCherchee Then
concat = concat & "," & Chr(10) & Cells(arTemp(X), "C").Value
End If
Wend

Next

'* Ici : Code pour copier les valeurs trouvées dans la colonne E
If Cells(ligneCell, "C").Value <> "" Then
Cells(ligneCell, "B").Value = Right(concat, Len(concat) - 1)
Cells(ligneCell, "B").Select

End If


--
Messages postés
34172
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
28 novembre 2021
357
Pourquoi vouloir fusionner alors que tu concatènes dans une cellule ... au final tu te retrouves avec 3 cellules par lignes... je ne vois pas à quoi te servirai alors la fusion....
Il te suffit, lorsque tu concatène, de supprimer les valeurs de leur position d'origine... puis.. lorsque ton programme est fini.. de supprimer toutes les lignes vides...
Messages postés
64
Date d'inscription
lundi 28 avril 2008
Statut
Membre
Dernière intervention
25 novembre 2014

Bonjour Jordane45,

Non je ne souhaite pas fusionner et non plus de supprimer. Ceci est un extrait d'un tableau de 100 colonnes et 32.000 lignes environ. Je souhaite juste concaténer les données en dessous de la cellule en gras jusqu'à la prochaine cellule en gras.

Pour l'instant j'y arrive que partiellement (seule la première cellule en dessous de la cellule en gras qui est copiée à l'adresse voulue).

Merci du temps que vous consacrez pour moi.