Suppression des doublons et regrouper les données dans sur une seule ligne

Bonjour,

Voilà déjà plusieurs codes VBA que j'essaye et sans succès.

Je vous joins le fichier Excel sur lequel j'aimerais adapter le code.

En exemple dans ce fichier, ce que je souhaiterais obtenir :

La partie tout de suite sous l'en-tête sont les données telle qu'elles sont envoyées dans le fichier

La deuxième partie ce sont les mêmes données regroupées sur une seule ligne, comme je souhaiterais qu'elles soient triées.

Avec les différents codes que j'ai essayés, j'arrive à supprimer les doublons de la colonne C et ne laisser qu'un seul n° d'article de chaque, additionner les valeurs supprimer de la colonne E et F après suppression des doublons, mais réunir dans une seule cellule le reste des données me pose problème.

J'ai laissé dans le Visual Basic une des nombreuses macro textée, elle ne fonctionne pas car pour l'exemple j'ai dû modifier la taille des cellules.

J'aurais vraiment besoin d'un petit coup de pouce.

Merci

Bonsoir à tous !

Une proposition via Power Query est-elle susceptible de convenir ?

Merci de préciser, dans votre profil, la nature de votre Excel ( 2013 ? 2016 ? 365 ? etc...)

Bonsoir,

C'est pour mon travail et je ne suis pas certain que mon poste et celui des collaborateurs qui utiliseront ce fichier soient équipés de Power Query.

J'ai mis à jour mon profil et la version est Excel 2016 FR.

Merci

Bonsoir à tous de nouveau !

Merci pour la mise à jour de votre profil !

Concernant Power Query, pour Excel 2010 et 2013, il est nécessaire d'installer un complément gratuit de Microsoft. A partir d'Excel 2016, l'outil est nativement intégré.

Hello,

Si tu as Excel 2016, PowerQuery est nativement intégré dedans.

Un essai, tu vas sur le tableau résultat et tu as juste à faire clic droit puis "actualiser" dessus pour le mettre à jour. Teste de rajouter des lignes dans le tableau sur l'onglet Feuil1

@+

Edit : JFL bonsoir, les post se sont superposés

Bonsoir,

Je ne connaissais pas Power Query et ça conviendrait parfaitement pour le projet.

Cependant, les données de la "Feuil1" comme de la "Feuille résultat" devront-êtres effacées régulièrement, la "Feuille résultat" devra en plus être actualisée fréquemment. Est-ce qui l'est possible de créer un Command Button ou un équivalent sous Power Query pour faire ces trois actions ? Vous allez me trouver exigeant, je sais que faire un clic droit et actualiser n'est pas compliqué, mais j'ai des personnes de l'atelier d'un certain âge qui ne sont pas très à l'aise avec l'informatique (il faut que ce soit le plus simple possible).

Les données sont exportées via une macro d'un second fichier, j'ai remarqué que quand j'effaçai les données du tableau de la "Feuil1" et que j'envoyais de nouvelles données, elles ne se mettaient pas automatiquement sur la première ligne, sous l'entête. Est-ce que c'est une modification au niveau du code VBA qu'il faut faire ou ça peut être fait sous Power Query?

Merci pour votre aide

Hello,

Voici la version corrigée avec le bouton pour actualiser le powerquery.

Je n'ai pas compris cette phrase par contre...

Les données sont exportées via une macro d'un second fichier, j'ai remarqué que quand j'effaçai les données du tableau de la "Feuil1" et que j'envoyais de nouvelles données, elles ne se mettaient pas automatiquement sur la première ligne, sous l'entête

L'onglet résultat se met à jour en fonction des infos de la feuil1. Tu veux dire qu'il faut faire un tri décroissant sur la date ?

@+

Bonjour Baroute78,

Ce que je voulais dire, c’est que les nouvelles données envoyées dans ce fichier vont à la suite de ce que j’ai effacé à la 11ème ligne par exemple et non automatiquement à partir de la 1 ère ligne.

Merci

Hello,

T'as un retraitement par vba qui vient coller les nouvelles valeurs comme suit : ca laisse les X premières lignes présentes dans le fichier et ça colle à la suite et toi tu voudrais quoi ? Que les lignes 2 à 9 soient supprimées et qu'ensuite tes nouvelles données soient collées en ligne 2 ?

@+

Hello,

Oui c’est ça, l’idéal serait que toutes les données du jour soient effacées automatiquement en fin de journée. ( je tente, si c’est possible. Qui ne demande rien n’a rien)

Merci POUPI

Re,

Pour moi, il faut modifier le vba directement.

Au lieu de venir coller à la suite après détermination de la dernière ligne (sûrement via une instruction qui ressemble à Range().End(xlup).Row), il faut dire à la macro de supprimer la plage déjà existante et ensuite de coller la nouvelle plage en A2

@+

Bonjour,

Je souhaitais vous remercier pour votre aide et tout particulièrement Baroute78, pour cette partie qui fonctionne parfaitement.

Je rencontre un autre problème, avec la macro.

J'ai ce message qui s'affiche de temps en temps.

"Erreur d'exécution "1004" : Cette sélection n'est pas valide. Vérifier que les zones de copie et de collage ne se chevauchent pas, sauf si elles ont la même taille et la même forme".

Quand je clic sur débogage, ça me renvoi à cette ligne:

Rows("3:3").Insert Shift:=xlDown

voici le code:

Private Sub CommandButton2_Click()

'Efface les saisies dans les combobox1,2 4 et 5 et les cellules F3 et G3

ComboBox1.Value = ""
ComboBox2.Value = ""
ComboBox3.Value = ""
ComboBox4.Value = ""
ComboBox5.Value = ""

Range("A3:A300").ClearContents
Range("F3:F300").ClearContents
Range("G3:G300").ClearContents
Range("H3:H300").ClearContents
Range("I3:I300").ClearContents

End Sub
Private Sub CommandButton4_Click()

' importe les données de la certification dans ce fichier

Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim wsDestination As Worksheet
Dim lastRow As Long
Dim i As Long

' Ouvrir le classeur source
' Set wbSource = Workbooks.Open("", ReadOnly:=True)
Set wbSource = Workbooks.Open("", ReadOnly:=True)

' Définir la feuille source et destination
Set wsSource = wbSource.Worksheets("Sheet1")
Set wsDestination = ThisWorkbook.Worksheets("Saisies")

' Vérifier si les données ont déjà été importées aujourd'hui
' If wsDestination.Range("A1").Value = Date Then
' MsgBox "Les données ont déjà été importées aujourd'hui", vbInformation, "Importation impossible"
' wbSource.Close SaveChanges:=False
' Exit Sub

' End If

' Trouver la dernière ligne de données dans la feuille destination
lastRow = wsDestination.Cells(wsDestination.Rows.Count, "B").End(xlUp).Row + 1

' Boucler à travers les données de la feuille source
For i = 2 To wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row

' Transférer les données dans la feuille destination
wsDestination.Cells(lastRow, "B").Value = wsSource.Cells(i, "A").Value
wsDestination.Cells(lastRow, "C").Value = wsSource.Cells(i, "F").Value
wsDestination.Cells(lastRow, "D").Value = wsSource.Cells(i, "I").Value
wsDestination.Cells(lastRow, "E").Value = wsSource.Cells(i, "I").Value

' Augmenter la valeur de la dernière ligne de données dans la feuille destination
lastRow = lastRow + 1

Next i

' Enregistrer la date de l'importation
wsDestination.Range("A1").Value = Date

' Fermer le classeur source sans enregistrer les modifications
wbSource.Close savechanges:=False

End Sub
Private Sub CommandButton5_Click()

' Vérifie si la colonne F3 est à zéro et efface les données de la ligne 3

ExportData

' Vérifier si la somme de E3 est à 0

If Range("E3").Value = 0 Then

' Effacer les données des cellules A3 à I3

Range("A3:I3").ClearContents

' Afficher un message de confirmation

MsgBox "Les données ont été transférées avec succès."

End If

' Vérifie si la colonne F3 est à zéro et efface les données de la ligne 3

'ExportData

' Vérifier si la somme de E3 est à 0
'If Range("E3").Value = 0 Then

' Effacer la ligne 3
'Range("3:3").Delete Shift:=xlUp

' Afficher un message de confirmation
'MsgBox "Les données ont été transférées avec succès."

'End If

End Sub
Private Sub ComboBox1_Change()

' Envoie les données dans la cellule A3

UpdateRowData
Range("A" & ActiveCell.Row).Value = ComboBox1.Value

End Sub
Private Sub ComboBox2_Change()

' Envoie les données dans la cellule F3 et déduit la quantité F3 de la quantité E3

UpdateRowData

Dim somme As Double
Dim cellE3 As Range
Dim cellF3 As Range
Dim row3 As Range

Set cellE3 = Range("E3")
Set cellF3 = Range("F3")
Set row3 = Range("A3:I3")

' Calcul de la somme à déduire
somme = cellF3.Value

' Vérification que la somme à déduire est bien inférieure ou égale à la somme restante
If somme > cellE3.Value Then
MsgBox "La somme à déduire est supérieure à la somme restante.", vbCritical
Else
' Déduction de la somme
cellE3.Value = cellE3.Value - somme

' Vérification que toutes les données de la ligne 3 sont remplies
If WorksheetFunction.CountA(row3) = row3.Cells.Count Then
' Toutes les données sont remplies, faire ce que vous voulez ici
Else

' Toutes les données ne sont pas remplies, attendre
'MsgBox "Remplir toutes les données de la ligne 3 de la colonne A à I.", vbInformation

End If
End If

End Sub
Private Sub ComboBox3_Change()

' Envoie les données dans la cellule G3

UpdateRowData

End Sub
Private Sub ComboBox4_Change()

' Envoie les données dans la cellule H3 "Codes défaut côté mouvement"

Dim selectedValue As String
Dim cellValue As String
Dim valueCount As Integer
Dim values As Variant
Dim newValue As String
Dim i As Integer

selectedValue = ComboBox4.Value
If selectedValue = "" Then Exit Sub

cellValue = Range("H3").Value
values = Split(cellValue, ",")
valueCount = 0

For i = 0 To ComboBox4.ListCount - 1
If ComboBox4.List(i) = selectedValue Then
valueCount = valueCount + 1

End If
Next i

If valueCount > 0 Then
newValue = selectedValue & " (" & valueCount & ")"
Else
newValue = selectedValue

End If

' Mettre en gras et en rouge les chiffres entre parenthèses
Dim startPosition As Integer
Dim endPosition As Integer
startPosition = InStr(1, newValue, "(") + 1
endPosition = InStr(1, newValue, ")") - 1
Range("H3").Characters(startPosition + Len(selectedValue), Len(CStr(valueCount))).Font.Bold = True
Range("H3").Characters(startPosition + Len(selectedValue), Len(CStr(valueCount))).Font.Color = RGB(255, 0, 0)

If InStr(1, cellValue, selectedValue) > 0 Then
cellValue = Replace(cellValue, selectedValue, newValue)
ElseIf cellValue = "" Then
cellValue = newValue
Else
cellValue = cellValue & ", " & newValue

End If

Range("H3").Value = cellValue

End Sub
Private Sub ComboBox5_Change()

' Envoie les données dans la cellule I3 "Codes défaut côté cadran"

Dim selectedValue As String
Dim cellValue As String
Dim valueCount As Integer
Dim values As Variant
Dim newValue As String
Dim i As Integer

selectedValue = ComboBox5.Value
If selectedValue = "" Then Exit Sub

cellValue = Range("I3").Value
values = Split(cellValue, ",")
valueCount = 0

For i = 0 To ComboBox5.ListCount - 1
If ComboBox5.List(i) = selectedValue Then
valueCount = valueCount + 1

End If

Next i

If valueCount > 0 Then
newValue = selectedValue & " (" & valueCount & ")"
Else
newValue = selectedValue

End If

' Mettre en gras et en rouge les chiffres entre parenthèses
Dim startPosition As Integer
Dim endPosition As Integer
startPosition = InStr(1, newValue, "(") + 1
endPosition = InStr(1, newValue, ")") - 1
Range("I3").Characters(startPosition + Len(selectedValue), Len(CStr(valueCount))).Font.Bold = True
Range("I3").Characters(startPosition + Len(selectedValue), Len(CStr(valueCount))).Font.Color = RGB(255, 0, 0)

If InStr(1, cellValue, selectedValue) > 0 Then
cellValue = Replace(cellValue, selectedValue, newValue)
ElseIf cellValue = "" Then
cellValue = newValue
Else
cellValue = cellValue & ", " & newValue

End If

Range("I3").Value = cellValue

End Sub
Private Sub UpdateRowData()

' Envoi les données des comboBox dans les celulles de la ligne selectionnée

Dim currentRow As Long
currentRow = ActiveCell.Row
Application.EnableEvents = False
Range("A" & currentRow).Value = ComboBox1.Value
Range("F" & currentRow).Value = ComboBox2.Value
Range("G" & currentRow).Value = ComboBox3.Value
'Range("H" & currentRow).Value = ComboBox3.Value
'Range("I" & currentRow).Value = ComboBox3.Value

Application.EnableEvents = True

End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

' Empêche le déplacement des lignes 1 et 2
If Target.Row <= 2 Then Exit Sub

' Renvoi la ligne selectionnée en ligne 3

If Target.Rows.Count = 1 Then
Application.EnableEvents = False
Target.Select
Target.Cut
Rows("3:3").Insert Shift:=xlDown
Range("3:3").Select 'Sélectionne toute la ligne 3
Application.EnableEvents = True

End If

End Sub
Private Sub ExportData()

' Envoi les données dans le classeur "Saisies pour livraison.

Dim wb As Workbook
Set wb = Workbooks.Open("")
'Set wb = Workbooks.Open("")
Dim ws As Worksheet
Set ws = wb.Sheets("Données")
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
ws.Cells(lastRow + 1, "A").Value = Range("A3").Value
ws.Cells(lastRow + 1, "B").Value = Range("B3").Value
ws.Cells(lastRow + 1, "C").Value = Range("C3").Value
ws.Cells(lastRow + 1, "D").Value = Range("D3").Value
ws.Cells(lastRow + 1, "E").Value = Range("F3").Value
ws.Cells(lastRow + 1, "F").Value = Range("G3").Value
ws.Cells(lastRow + 1, "G").Value = Range("H3").Value
ws.Cells(lastRow + 1, "H").Value = Range("I3").Value
wb.Save
wb.Close

End Sub

Merci

Hello,

Merci pour ce retour :)

A première vue je dirais qu’il y a peut être un conflit entre le moment où il fait le cut, qu’il y a l’insertion de ligne et la sélection d’une ligne déjà sélectionnée par le cut, tu vois ce que je veux dire ?

Après je pense que le code a l’air un peu complexe pour les manipulations qui sont faites.

N’hésite pas si besoin et bonne nuit =D

@+