Discussion :

[polobabou]

Bonjour
Je viens vers la communauté car je n'arrive pas à fusionner deux listes avec des champs différemment complétés.
Il est plus simple de regarder l'exemple plutôt d'expliquer :
J'ai deux listes (dossier 1 et dossier 2) qui sont caractérisées par des champs descriptifs différemment complétés. (pourquoi deux listes --> données reçues via formulaire en XML que j'extrais en VBA.
La difficulté est liée au fait que les cellules ne sont pas tjs remplies.
Je souhaite avoir qu'une seule colonne de champs et les deux listes ensembles --> objectif : pouvoir utiliser la fonction filtre par la suite

Je cherche si une fonction XLS permet de résoudre mon problème?

Sinon, Est-ce que je dois développer une macro en vba.
1) balayage de la liste fusionnée avec comparaison des cellules du champs
2) si identique on déplace la cellule non vide vers la ligne supérieure
3) suppression de la ligne en double , ...
4) on refait la boucle

Cela risque d'être long car mon fichier original fai =/- 900 champs

Je joins un fichier exemple .

Merci pour vos conseils

bien à vous

[jerome.vaussenat]

Salut,

Je ne vois pas comment faire çà sans macro.
Voici une proposition de code.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub suppr()
    Dim ligne As Integer
 
    ligne = 3
    Do While Cells(ligne, 7).Value <> ""
        If Cells(ligne, 7).Value = Cells(ligne + 1, 7).Value Then
            Cells(ligne, 9).Value = Cells(ligne + 1, 9).Value
            Cells(ligne + 1, 9).EntireRow.Delete
        End If
        ligne = ligne + 1
    Loop
End Sub

Je suis parti comme dans ton exemple sur les colonnes G et I dans la macro, les nombres 7 et 9.

[polobabou]

Merci pour le petit "LOOP"

Voici ce que j'ai réalisé comme macro en partant de la cellule A1.
J'ai essayé que les déplacements soient réalisés par les déplacements rapides pour qu'ils soient adaptés à n'importe quelle taille des zones.
Ce ne n'est pas une macro très standard : je dois encore voir comment mesurer les tailles des zones de manière automatique.
Le tri est orienté sur une zone précise "A1:C12" : je dois voir si je ne dois pas la définir par une variable car la zone est variable en fonction des formulaires complétés

La macro est adaptée au fichier v2 joint

ps: je ne sais pas comment on intègre du code correctement dans le message , j'ai fait un copier/coller

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
Sub Suppressiondoublon()
 
 Cells.Find(What:="champs", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Range(Selection, Selection.End(xlDown)).Select
    ActiveCell.Range("A1:B7").Select
    Application.CutCopyMode = False
    Selection.Cut
    Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(0, 1).Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Select
    Selection.Cut
    Selection.End(xlUp).Select
    ActiveSheet.Paste
    Range("A1").Select
    Cells.Find(What:="champs", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Rows("1:1").EntireRow.Select
    Selection.Delete Shift:=xlUp
    ActiveCell.Offset(-6, 0).Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveCell.Range("A1:C12").Select
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=ActiveCell, _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange ActiveCell.Range("A1:C12")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
 
' tri des lignes
 
    ligne = 2
    Do While Cells(ligne, 1).Value <> ""
        If Cells(ligne, 1).Value = Cells(ligne + 1, 1).Value Then
            Cells(ligne, 3).Value = Cells(ligne + 1, 3).Value
            Cells(ligne + 1, 3).EntireRow.Delete
        End If
        ligne = ligne + 1
    Loop
End Sub

[polobabou]

merci pour l'aide
Je vais encore améliorer pour les déplacements

Merci pour la séquence

Bien à vous