citizenbaban
XLDnaute Junior
Bonjour à tous,
J'ai un petit problème avec une macro. Voici l'idée :
Je voudrais fusionner des lignes de B à H, si et seulement si, des dates en colonne A sont identiques sur plusieurs lignes.
Par exemple :
12/03/13 50 60 "vide" 10
12/03/13 50 60 "vide" 10
12/03/13 "vide" "vide" 100 "vide"
Donnerait :
12/03/13 50 60 100 10
En me balladant ici et ailleurs, j'ai trouvé un code qui fonctionne bien pour ce que la personne recherchait, mais pour être honnête, je ne le comprend pas ^^ Du coup ça serait surtout pour avoir quelques explications sur ce code, à quel chiffre correspond les colonnes, les lignes, etc. Car même en tatonnant, je n'obtiens que des résultats bizarres ^^
Voici le code :
Je ne sais plus ou je l'ai récupéré, donc si quelqu'un reconnait son code, désolé pour l'absence de référence
Merci beaucoup.
Citizen
J'ai un petit problème avec une macro. Voici l'idée :
Je voudrais fusionner des lignes de B à H, si et seulement si, des dates en colonne A sont identiques sur plusieurs lignes.
Par exemple :
12/03/13 50 60 "vide" 10
12/03/13 50 60 "vide" 10
12/03/13 "vide" "vide" 100 "vide"
Donnerait :
12/03/13 50 60 100 10
En me balladant ici et ailleurs, j'ai trouvé un code qui fonctionne bien pour ce que la personne recherchait, mais pour être honnête, je ne le comprend pas ^^ Du coup ça serait surtout pour avoir quelques explications sur ce code, à quel chiffre correspond les colonnes, les lignes, etc. Car même en tatonnant, je n'obtiens que des résultats bizarres ^^
Voici le code :
Code:
Sub Groupage()
Dim Col As Integer, Lg As Long, nLg As Byte, Nom As String
Application.ScreenUpdating = False
Nom = Cells(2, 2): Lg = 2
While Nom <> ""
While Cells(Lg, 2).Offset(nLg, 0) = Nom
nLg = nLg + 1
For Col = 3 To 7
If Cells(Lg, Col) = "" Then
Cells(Lg, Col) = Cells(Lg, Col).Offset(nLg, 0)
End If
Next
Wend
Lg = Lg + nLg
Nom = Cells(Lg, 2)
nLg = 0
Wend
For Lg = Range("B" & Rows.Count).End(xlUp).Row To 2 Step -1
If Application.WorksheetFunction.CountIf(Feuil1.Range("B:B"), Cells(Lg, 2).Value) > 1 Then
Rows(Lg).EntireRow.Delete
End If
Next
Application.ScreenUpdating = True
End Sub
Je ne sais plus ou je l'ai récupéré, donc si quelqu'un reconnait son code, désolé pour l'absence de référence
Merci beaucoup.
Citizen