Modification conditionnelle de la mise en forme
Bonjour à toutes et à tous,
Je sollicite humblement l'aide du forum et de ses membres pour tenter de résoudre un véritable casse-tête
Je travaille sur un imposant fichier client.
Pour l'utilisation que j'en fais (géocodage de masse), il est impératif que les adresses (qui occupent un nombre variable de cellules) soient regroupées puis déplacées pour constituer une colonne distincte.
La seule récurrence que j'observe est la suivante : la date est renseignée en Ax, Bx contient le nom du client, et aux cellules vides Ay, Az... sous-jacentes correspondent les cellules By, Bz... qui contiennent l'adresse du client.
De cette récurrence, j'entrevois deux marches à suivre, qui je l'espère, seront réalisables :
- - quand Ax est renseigné, fusionner la plage de cellules B correspondantes aux cellules A vides sous-jacentes, et la déplacer en Cx
- quand les cellules de la colonne A sont vides de Ax à Ax+n, fusionner la plage de cellules Bx à Bx+n correspondantes et la déplacer en Cx-1
Voilà où j'en suis, je ne sais pas si c'est réalisable, encore moins comment le mettre en place le cas échéant, ou encore si d'autres possibilités m'ont échappées. Mes connaissances Excel étant (très) modestes, je m'en remets à vos mains expertes !
Merci d'avance pour votre aide,
Florian
Bonjour,
A tester :
Sub TraiterClients()
Dim cli, n%, i%, d%, lf%
With ActiveSheet
n = .Cells(.Rows.Count, 2).End(xlUp).Row
For i = n To 2 Step -1
If .Cells(i, 2) = "" Then
If .Cells(i, 1) = "" Then .Rows(i).Delete
End If
Next i
n = .Cells(.Rows.Count, 2).End(xlUp).Row: lf = n
For i = n To 2 Step -1
If .Cells(i, 1) <> "" Then
cli = .Cells(i, 2)
If lf > i Then
For d = i + 1 To lf
cli = cli & Chr(10) & .Cells(d, 2)
Next d
.Range(.Cells(i + 1, 1), .Cells(lf, 2)).Delete xlShiftUp
End If
With .Cells(i, 2)
.Value = cli
.WrapText = True
End With
lf = i - 1: cli = ""
End If
Next i
End With
End SubCordialement.
MFerrand, merci pour votre aide ! Le seul hic, c'est qu'avec ce code, clients & adresses se retrouvent dans la même cellule.
gmb, MERCI INFINIMENT ! Quelque chose que je pensais infaisable, vous l'avez bien compris et vous l'avez réalisé, en quelques minutes seulement. C'est incroyable ! Vous me tirez d'une impasse, et je vous en suis très reconnaissant.
Pourriez-vous m'expliquer succintement l'opération qu'effectue la macro ?
Un dernier point, est-ce possible d'initier cette manoeuvre uniquement lorsque Ax est une date (type 01/01/01) ? Car il y a certaines cellules parasites dans mon fichier, et ca me permettrait de m'en débarrasser par la même occasion.
Désolé !
Mais détail vite rectifié !
Sub TraiterClients()
Dim cli, n%, i%, d%, lf%
With ActiveSheet
n = .Cells(.Rows.Count, 2).End(xlUp).Row
For i = n To 2 Step -1
If .Cells(i, 2) = "" Then
If .Cells(i, 1) = "" Then .Rows(i).Delete
End If
Next i
n = .Cells(.Rows.Count, 2).End(xlUp).Row: lf = n
For i = n To 2 Step -1
If .Cells(i, 1) <> "" Then
If lf > i Then
For d = i + 1 To lf
cli = cli & Chr(10) & .Cells(d, 2)
Next d
cli = Replace(cli, Chr(10), "", 1, 1)
.Range(.Cells(i + 1, 1), .Cells(lf, 3)).Delete xlShiftUp
End If
With .Cells(i, 3)
.Value = cli
.WrapText = True
End With
.Cells(i, 1).Resize(, 3).VerticalAlignment = xlCenter
lf = i - 1: cli = ""
End If
Next i
End With
End SubPour la question des dates, il serait souhaitable que tu fournisses un échantillon de ce que tu nommes cellules parasites...
Cordialement.
Bonjour à tous
FloFlo13 a écrit :Pourriez-vous m'expliquer succintement l'opération qu'effectue la macro ?
Ci-joint la macro commentée.
Pour ce qui est des dates parasites, j'ai la même remarque que MFerrand : il faudrait disposer d'un exemple contenant de tels parasites...
Bye !
MFerrand, merci beaucoup, j'étends à toi la reconnaissance déjà exprimée pour gmb !
gmb, merci pour l'explication !
En fait, toutes les données pertinentes pour moi débutent par une date de type xx/xx/xx en A.
Les cellules parasites, inutiles, de mon fichier sont celles qui contiennent des "données" autres. Par exemple en Ax, on retrouve des textes et des caractères divers (des tirets "-" notamment).
Serait-il possible de les écarter concomitamment ?
Dans Excel, les dates sont des nombres (de type Long), la façon dont elles apparaissent n'est qu'une question de format de cellule.
Le problème est que selon l'origine des données, les dates peuvent être sous forme de texte, non reconnues pas Excel comme dates (à moins de les convertir...)
Modification pour tester les dates en évitant d'éliminer les dates qui ne seraient pas des données de type date...
Sub TraiterClients()
Dim cli, n%, i%, d%, lf%
With ActiveSheet
n = .Cells(.Rows.Count, 2).End(xlUp).Row
lf = .Cells(.Rows.Count, 1).End(xlUp).Row
n = IIf(n > lf, n, lf)
For i = n To 2 Step -1
Select Case VarType(.Cells(i, 1))
Case 7, 3
Case 0
If .Cells(i, 2) = "" Then .Rows(i).Delete
Case 8
If .Cells(i, 1) = "" And .Cells(i, 2) = "" Then
.Rows(i).Delete
ElseIf .Cells(i, 1) Like "*/*/*" Then
Else
.Rows(i).Delete
End If
Case Else
.Rows(i).Delete
End Select
Next i
n = .Cells(.Rows.Count, 2).End(xlUp).Row: lf = n
For i = n To 2 Step -1
If .Cells(i, 1) <> "" Then
If lf > i Then
For d = i + 1 To lf
cli = cli & Chr(10) & .Cells(d, 2)
Next d
cli = Replace(cli, Chr(10), "", 1, 1)
.Range(.Cells(i + 1, 1), .Cells(lf, 3)).Delete xlShiftUp
End If
With .Cells(i, 3)
.Value = cli
.WrapText = True
End With
.Cells(i, 1).Resize(, 3).VerticalAlignment = xlCenter
lf = i - 1: cli = ""
End If
Next i
End With
End SubLa modification est surlignée.
A tester sur un échantillon significatif pour vérifier que cela remplit bien la fonction.
Cordialement.
NB- Désolé pour la première ligne surlignée qui ne respecte pas l'indentation (alignement avec les lignes précédentes et suivantes) mais impossible de l'obtenir avec le surlignage... !?
Impressionnant ! Vos deux macros remplissent parfaitement leur fonction, et solutionnent entièrement mon problème.
Merci à vous deux pour votre aide, votre talent, votre rapidité. C'est à peine croyable ! Encore une fois, je vous en suis très reconnaissant.
À bientôt, et longue vie à ce forum !