Je souhaiterais pour chaque type de donn=E9es dans la colonne A, regrouper =
les donn=E9es de la colonne B dans une seule cellule, en les s=E9parant par=
des " ;".
Soit=20
100_1 109J 1 ; 109J 11-13 ; 109J 3 ; (...) ; 113J 1-2
100_2 123J 2 ; 131J 26-39 ; (...) ; 131J 70-73
etc
Avec les formules je ne m'en sors pas...
Merci d'avance.
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
MichD
Bonjour,
Essaie quelque chose comme ceci :
J'ai supposé que tes données dans ton tableau sont présentées en ordre croissant comme dans ton exemple!
'-------------------------------------------------------------------------- Sub test()
Dim DerLig As Long, A As Long, X As String Dim S As String, Compteur As Long, Rg As Range
'Adapte le nom de la "Feuil1" selon le nom de l'onglet 'où se retrouvent les données With Worksheets("Feuil1") DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
'Si tes données débutent à une autre ligne que A1 'modifie A1 dans la ligne suivante pour l'adresse 'de la cellule où débutent les données Set Rg = .Range("A1:A" & DerLig) End With
'La copie des données se fera à partir de la première 'ligne des données. For A = 1 To Rg.Rows.Count Compteur = Compteur + 1 X = Split(Rg(A), " ")(0) Do While InStr(1, Rg(A), X, vbTextCompare) > 0 S = S & Rg(A) & ";" A = A + 1 Loop If S <> "" Then S = Left(S, Len(S) - 1) Rg(1, 1).Offset(Compteur - 1, 1) = S S = "" End If A = A - 1 Next Rg(1, 1).Offset(, 1).EntireColumn.AutoFit End Sub '--------------------------------------------------------------------------
Bonjour,
Essaie quelque chose comme ceci :
J'ai supposé que tes données dans ton tableau sont présentées en ordre croissant
comme dans ton exemple!
'--------------------------------------------------------------------------
Sub test()
Dim DerLig As Long, A As Long, X As String
Dim S As String, Compteur As Long, Rg As Range
'Adapte le nom de la "Feuil1" selon le nom de l'onglet
'où se retrouvent les données
With Worksheets("Feuil1")
DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
'Si tes données débutent à une autre ligne que A1
'modifie A1 dans la ligne suivante pour l'adresse
'de la cellule où débutent les données
Set Rg = .Range("A1:A" & DerLig)
End With
'La copie des données se fera à partir de la première
'ligne des données.
For A = 1 To Rg.Rows.Count
Compteur = Compteur + 1
X = Split(Rg(A), " ")(0)
Do While InStr(1, Rg(A), X, vbTextCompare) > 0
S = S & Rg(A) & ";"
A = A + 1
Loop
If S <> "" Then
S = Left(S, Len(S) - 1)
Rg(1, 1).Offset(Compteur - 1, 1) = S
S = ""
End If
A = A - 1
Next
Rg(1, 1).Offset(, 1).EntireColumn.AutoFit
End Sub
'--------------------------------------------------------------------------
J'ai supposé que tes données dans ton tableau sont présentées en ordre croissant comme dans ton exemple!
'-------------------------------------------------------------------------- Sub test()
Dim DerLig As Long, A As Long, X As String Dim S As String, Compteur As Long, Rg As Range
'Adapte le nom de la "Feuil1" selon le nom de l'onglet 'où se retrouvent les données With Worksheets("Feuil1") DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
'Si tes données débutent à une autre ligne que A1 'modifie A1 dans la ligne suivante pour l'adresse 'de la cellule où débutent les données Set Rg = .Range("A1:A" & DerLig) End With
'La copie des données se fera à partir de la première 'ligne des données. For A = 1 To Rg.Rows.Count Compteur = Compteur + 1 X = Split(Rg(A), " ")(0) Do While InStr(1, Rg(A), X, vbTextCompare) > 0 S = S & Rg(A) & ";" A = A + 1 Loop If S <> "" Then S = Left(S, Len(S) - 1) Rg(1, 1).Offset(Compteur - 1, 1) = S S = "" End If A = A - 1 Next Rg(1, 1).Offset(, 1).EntireColumn.AutoFit End Sub '--------------------------------------------------------------------------
MichD
Celle-ci est mieux adaptée si tu as beaucoup de données. C'est quasiment la même chose!
'--------------------------------------------------------------------------- Sub test()
Dim DerLig As Long, A As Long, X As String Dim S As String, Compteur As Long, Rg As Range
'Adapte le nom de la "Feuil1" selon le nom de l'onglet 'où se retrouvent les données With Worksheets("Feuil1") DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
'Si tes données débutent à une autre ligne que A1 'modifie A1 dans la ligne suivante pour l'adresse 'de la cellule où débutent les données Set Rg = .Range("A1:A" & DerLig) End With
'La copie des données se fera à partir de la première 'ligne des données. For A = 1 To Rg.Rows.Count Compteur = Compteur + 1 X = Split(Rg(A), " ")(0) Do While InStr(1, Rg(A), X, vbTextCompare) > 0 S = S & Rg(A) & ";" A = A + 1 Loop If S <> "" Then S = Left(S, Len(S) - 1) Rg(1, 1).Offset(Compteur - 1, 1) = S S = "" End If A = A - 1 Next Rg(1, 1).Offset(, 1).EntireColumn.AutoFit
'Adapte le nom de la "Feuil1" selon le nom de l'onglet
'où se retrouvent les données
With Worksheets("Feuil1")
DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
'Si tes données débutent à une autre ligne que A1
'modifie A1 dans la ligne suivante pour l'adresse
'de la cellule où débutent les données
Set Rg = .Range("A1:A" & DerLig)
End With
'La copie des données se fera à partir de la première
'ligne des données.
For A = 1 To Rg.Rows.Count
Compteur = Compteur + 1
X = Split(Rg(A), " ")(0)
Do While InStr(1, Rg(A), X, vbTextCompare) > 0
S = S & Rg(A) & ";"
A = A + 1
Loop
If S <> "" Then
S = Left(S, Len(S) - 1)
Rg(1, 1).Offset(Compteur - 1, 1) = S
S = ""
End If
A = A - 1
Next
Rg(1, 1).Offset(, 1).EntireColumn.AutoFit
'Adapte le nom de la "Feuil1" selon le nom de l'onglet 'où se retrouvent les données With Worksheets("Feuil1") DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
'Si tes données débutent à une autre ligne que A1 'modifie A1 dans la ligne suivante pour l'adresse 'de la cellule où débutent les données Set Rg = .Range("A1:A" & DerLig) End With
'La copie des données se fera à partir de la première 'ligne des données. For A = 1 To Rg.Rows.Count Compteur = Compteur + 1 X = Split(Rg(A), " ")(0) Do While InStr(1, Rg(A), X, vbTextCompare) > 0 S = S & Rg(A) & ";" A = A + 1 Loop If S <> "" Then S = Left(S, Len(S) - 1) Rg(1, 1).Offset(Compteur - 1, 1) = S S = "" End If A = A - 1 Next Rg(1, 1).Offset(, 1).EntireColumn.AutoFit
End Sub '---------------------------------------------------------------------------
jip
Le jeudi 24 septembre 2015 15:52:47 UTC+2, MichD a écrit :
Bonjour,
Essaie quelque chose comme ceci :
J'ai supposé que tes données dans ton tableau sont présentées en ordre croissant comme dans ton exemple!
'------------------------------------------------------------------------ -- Sub test()
Dim DerLig As Long, A As Long, X As String Dim S As String, Compteur As Long, Rg As Range
'Adapte le nom de la "Feuil1" selon le nom de l'onglet 'où se retrouvent les données With Worksheets("Feuil1") DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
'Si tes données débutent à une autre ligne que A1 'modifie A1 dans la ligne suivante pour l'adresse 'de la cellule où débutent les données Set Rg = .Range("A1:A" & DerLig) End With
'La copie des données se fera à partir de la première 'ligne des données. For A = 1 To Rg.Rows.Count Compteur = Compteur + 1 X = Split(Rg(A), " ")(0) Do While InStr(1, Rg(A), X, vbTextCompare) > 0 S = S & Rg(A) & ";" A = A + 1 Loop If S <> "" Then S = Left(S, Len(S) - 1) Rg(1, 1).Offset(Compteur - 1, 1) = S S = "" End If A = A - 1 Next Rg(1, 1).Offset(, 1).EntireColumn.AutoFit End Sub '------------------------------------------------------------------------ --
Bonjour et merci. Le résultat est presque correct puisque j'obtiens : 100_1 100_1;100_1;100_1;100_1;100_1;100_1 100_1 100_2;100_2;100_2;100_2;100_2 etc les données à regrouper sont en colonne B, que modifier ? Merci encore
Le jeudi 24 septembre 2015 15:52:47 UTC+2, MichD a écrit :
Bonjour,
Essaie quelque chose comme ceci :
J'ai supposé que tes données dans ton tableau sont présentées en ordre croissant
comme dans ton exemple!
'------------------------------------------------------------------------ --
Sub test()
Dim DerLig As Long, A As Long, X As String
Dim S As String, Compteur As Long, Rg As Range
'Adapte le nom de la "Feuil1" selon le nom de l'onglet
'où se retrouvent les données
With Worksheets("Feuil1")
DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
'Si tes données débutent à une autre ligne que A1
'modifie A1 dans la ligne suivante pour l'adresse
'de la cellule où débutent les données
Set Rg = .Range("A1:A" & DerLig)
End With
'La copie des données se fera à partir de la première
'ligne des données.
For A = 1 To Rg.Rows.Count
Compteur = Compteur + 1
X = Split(Rg(A), " ")(0)
Do While InStr(1, Rg(A), X, vbTextCompare) > 0
S = S & Rg(A) & ";"
A = A + 1
Loop
If S <> "" Then
S = Left(S, Len(S) - 1)
Rg(1, 1).Offset(Compteur - 1, 1) = S
S = ""
End If
A = A - 1
Next
Rg(1, 1).Offset(, 1).EntireColumn.AutoFit
End Sub
'------------------------------------------------------------------------ --
Bonjour et merci.
Le résultat est presque correct puisque j'obtiens :
100_1 100_1;100_1;100_1;100_1;100_1;100_1
100_1 100_2;100_2;100_2;100_2;100_2
etc
les données à regrouper sont en colonne B, que modifier ?
Merci encore
Le jeudi 24 septembre 2015 15:52:47 UTC+2, MichD a écrit :
Bonjour,
Essaie quelque chose comme ceci :
J'ai supposé que tes données dans ton tableau sont présentées en ordre croissant comme dans ton exemple!
'------------------------------------------------------------------------ -- Sub test()
Dim DerLig As Long, A As Long, X As String Dim S As String, Compteur As Long, Rg As Range
'Adapte le nom de la "Feuil1" selon le nom de l'onglet 'où se retrouvent les données With Worksheets("Feuil1") DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
'Si tes données débutent à une autre ligne que A1 'modifie A1 dans la ligne suivante pour l'adresse 'de la cellule où débutent les données Set Rg = .Range("A1:A" & DerLig) End With
'La copie des données se fera à partir de la première 'ligne des données. For A = 1 To Rg.Rows.Count Compteur = Compteur + 1 X = Split(Rg(A), " ")(0) Do While InStr(1, Rg(A), X, vbTextCompare) > 0 S = S & Rg(A) & ";" A = A + 1 Loop If S <> "" Then S = Left(S, Len(S) - 1) Rg(1, 1).Offset(Compteur - 1, 1) = S S = "" End If A = A - 1 Next Rg(1, 1).Offset(, 1).EntireColumn.AutoFit End Sub '------------------------------------------------------------------------ --
Bonjour et merci. Le résultat est presque correct puisque j'obtiens : 100_1 100_1;100_1;100_1;100_1;100_1;100_1 100_1 100_2;100_2;100_2;100_2;100_2 etc les données à regrouper sont en colonne B, que modifier ? Merci encore
MichD
Si tes données sont en colonne B, le résultat s'affichera en colonne C et débuteront à la première ligne des données en colonne B.
'------------------------------------------------------------------ Sub test()
Dim DerLig As Long, A As Long, X As String Dim S As String, Compteur As Long, Rg As Range
'Adapte le nom de la "Feuil1" selon le nom de l'onglet 'où se retrouvent les données With Worksheets("Feuil1") DerLig = .Range("B" & .Rows.Count).End(xlUp).Row
'Si tes données débutent à une autre ligne que B1 'modifie b1 dans la ligne suivante pour l'adresse 'de la cellule où débutent les données Set Rg = .Range("B1:B" & DerLig) End With
'La copie des données se fera à partir de la première 'ligne des données. For A = 1 To Rg.Rows.Count Compteur = Compteur + 1 X = Split(Rg(A), " ")(0) Do While InStr(1, Rg(A), X, vbTextCompare) > 0 S = S & Rg(A) & ";" A = A + 1 Loop If S <> "" Then S = Left(S, Len(S) - 1) Rg(1, 1).Offset(Compteur - 1, 1) = S S = "" End If A = A - 1 Next Rg(1, 1).Offset(, 1).EntireColumn.AutoFit
'Adapte le nom de la "Feuil1" selon le nom de l'onglet
'où se retrouvent les données
With Worksheets("Feuil1")
DerLig = .Range("B" & .Rows.Count).End(xlUp).Row
'Si tes données débutent à une autre ligne que B1
'modifie b1 dans la ligne suivante pour l'adresse
'de la cellule où débutent les données
Set Rg = .Range("B1:B" & DerLig)
End With
'La copie des données se fera à partir de la première
'ligne des données.
For A = 1 To Rg.Rows.Count
Compteur = Compteur + 1
X = Split(Rg(A), " ")(0)
Do While InStr(1, Rg(A), X, vbTextCompare) > 0
S = S & Rg(A) & ";"
A = A + 1
Loop
If S <> "" Then
S = Left(S, Len(S) - 1)
Rg(1, 1).Offset(Compteur - 1, 1) = S
S = ""
End If
A = A - 1
Next
Rg(1, 1).Offset(, 1).EntireColumn.AutoFit
'Adapte le nom de la "Feuil1" selon le nom de l'onglet 'où se retrouvent les données With Worksheets("Feuil1") DerLig = .Range("B" & .Rows.Count).End(xlUp).Row
'Si tes données débutent à une autre ligne que B1 'modifie b1 dans la ligne suivante pour l'adresse 'de la cellule où débutent les données Set Rg = .Range("B1:B" & DerLig) End With
'La copie des données se fera à partir de la première 'ligne des données. For A = 1 To Rg.Rows.Count Compteur = Compteur + 1 X = Split(Rg(A), " ")(0) Do While InStr(1, Rg(A), X, vbTextCompare) > 0 S = S & Rg(A) & ";" A = A + 1 Loop If S <> "" Then S = Left(S, Len(S) - 1) Rg(1, 1).Offset(Compteur - 1, 1) = S S = "" End If A = A - 1 Next Rg(1, 1).Offset(, 1).EntireColumn.AutoFit
'Adapte le nom de la "Feuil1" selon le nom de l'onglet 'où se retrouvent les données With Worksheets("Feuil1") DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
'Si tes données débutent à une autre ligne que A1 'modifie A1 dans la ligne suivante pour l'adresse 'de la cellule où débutent les données Set Rg = .Range("A1:A" & DerLig) End With
'La copie des données se fera à partir de la première 'ligne des données. For A = 1 To Rg.Rows.Count Compteur = Compteur + 1 X = Rg(A) Do While InStr(1, Rg(A), X, vbTextCompare) > 0 S = S & Rg(A).Offset(, 1) & ";" A = A + 1 Loop If S <> "" Then S = Left(S, Len(S) - 1) Rg(Compteur, 1).Offset(, 2) = S S = "" End If A = A - 1 Next Rg(1, 1).Offset(, 1).EntireColumn.AutoFit
'Adapte le nom de la "Feuil1" selon le nom de l'onglet
'où se retrouvent les données
With Worksheets("Feuil1")
DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
'Si tes données débutent à une autre ligne que A1
'modifie A1 dans la ligne suivante pour l'adresse
'de la cellule où débutent les données
Set Rg = .Range("A1:A" & DerLig)
End With
'La copie des données se fera à partir de la première
'ligne des données.
For A = 1 To Rg.Rows.Count
Compteur = Compteur + 1
X = Rg(A)
Do While InStr(1, Rg(A), X, vbTextCompare) > 0
S = S & Rg(A).Offset(, 1) & ";"
A = A + 1
Loop
If S <> "" Then
S = Left(S, Len(S) - 1)
Rg(Compteur, 1).Offset(, 2) = S
S = ""
End If
A = A - 1
Next
Rg(1, 1).Offset(, 1).EntireColumn.AutoFit
'Adapte le nom de la "Feuil1" selon le nom de l'onglet 'où se retrouvent les données With Worksheets("Feuil1") DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
'Si tes données débutent à une autre ligne que A1 'modifie A1 dans la ligne suivante pour l'adresse 'de la cellule où débutent les données Set Rg = .Range("A1:A" & DerLig) End With
'La copie des données se fera à partir de la première 'ligne des données. For A = 1 To Rg.Rows.Count Compteur = Compteur + 1 X = Rg(A) Do While InStr(1, Rg(A), X, vbTextCompare) > 0 S = S & Rg(A).Offset(, 1) & ";" A = A + 1 Loop If S <> "" Then S = Left(S, Len(S) - 1) Rg(Compteur, 1).Offset(, 2) = S S = "" End If A = A - 1 Next Rg(1, 1).Offset(, 1).EntireColumn.AutoFit
