Concatèner à l'aide d'une macro

Question

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.

--

ucfoutu · Answer

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é.

Whismeril · Answer

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 :

.
Quand la solution est trouvée, mettre la discussion Résolue.

jordane45 · Answer

Sans oublier que des sujets identiques ont déjà été traité sur ce forum.

sokpassy85 · Answer

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_TrapDim rFnd As Range ' Range ObjectDim iArr As Integer ' Counter for ArrayDim rFirstAddress ' Address of the First Find' -----------------' Clear the Array' -----------------Erase arMatchesSet rFnd = oSht.Range(sRange).Find(what:=sText, LookIn:=xlValues, lookAt:=xlPart)If Not rFnd Is Nothing ThenrFirstAddress = rFnd.AddressDo Until rFnd Is NothingiArr = iArr + 1ReDim Preserve arMatches(iArr)arMatches(iArr) = rFnd.Row 'rFnd.Address pour adresse complete ' rFnd.Row Pour N° de ligneSet rFnd = oSht.Range(sRange).FindNext(rFnd)If rFnd.Address = rFirstAddress Then Exit Do ' Do not allow wrapped searchLoopFindAll = TrueElse' ----------------------' No Value is Found' ----------------------FindAll = FalseEnd If' -----------------------' Error Handling' -----------------------Err_Trap:If Err <> 0 ThenMsgBox Err.Number & " " & Err.Description, vbInformation, "Find All"Err.ClearFindAll = FalseExit FunctionEnd IfEnd FunctionSub Conc()'------------------------------------------------------' Tableau contenant la liste des lignes trouvées' par la méthode findAll()'------------------------------------------------------Dim arTemp() As String'------------------------------------------------------' Autres variables :'------------------------------------------------------Dim nomF As StringDim 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 AFor 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 IfNext --

sokpassy85 · Answer

Bonjour,

vous avez raison, merci beaucoup pour vos coups de pouce.

sokpassy85 · Answer

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 
 
--

Concatèner à l'aide d'une macro

6 réponses

Votre réponse

Discussions similaires