Fusionner cellule selon condition

Le
jonathansol86
Bonjour


je voudrais savoir comment faire pour créer une macro qui fusionnerai =
les cellules si celles ci sont identiques dans la même colonne , sacha=
nt que les valeurs change à chaque nouveau fichier que je traite.

Je commence juste en vba
j'ai crée une condition avec If ca marche pour la première ligne =
mais c'est tout il doit être possible d'intégrer ça dans une=
boucle non ?


Exemple de valeurs

913573
913573
913573
913573
913573
913573
913583
913583
913583
913583
913593
913593
913593
913603
913603
913603
913613
913613
913623
913623
913623
913623
913633
913633
913633
913633
913643
913643
913643
913653
913653
913653
913663
913663
913663
913673
913902
913912
913912
913912
913922
913922
913922
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Jc
Le #26544661
Le 17/04/2020, a supposé :
Bonjour
je voudrais savoir comment faire pour créer une macro qui fusionnerai les
cellules si celles ci sont identiques dans la même colonne , sachant que les
valeurs change à chaque nouveau fichier que je traite.
Je commence juste en vba
j'ai crée une condition avec If ca marche pour la première ligne mais c'est
tout il doit être possible d'intégrer ça dans une boucle non ?

Bonjour,
J'immagine qu'il s'agit d'Excel
La macro suivante devrait faire l'affaire
A adapter en fontion du fichier
PS déplace la question dans le forum d'excel, les réponses seront plus
nombreuses
En esprant que celà conviennet bon dimanche
Public Sub Fusion()
Dim i As Long, j As Long
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
'Hypothèse : les données sont dans la colonne A et débutent à la ligne
1
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
On Error GoTo Fusion_Error
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
For i = 1 To Cells(65535, 1).End(xlUp).Row
j = i
Do While Cells(i, 1) = Cells(j + 1, 1)
j = j + 1
Loop
Range(Cells(i, 1), Cells(j, 1)).Merge
i = j
Next i
On Error GoTo 0
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Exit Sub
Fusion_Error:
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub
--
______________________________________________
Jc
Publicité
Poster une réponse
Anonyme