Discussion :

[homère]

Bonjour,
Malgré mes recherches je n'ai pu écrire le code vba pour résoudre le problème ci-dessous. Une aide serait la bienvenue ...
Je suis en excel 2003.
J'ai un fichier d'association du type : Civilité (A), Prénom (B), Nom (C), Adresse (D), Code postal (E), Ville (F). Adhérent (G), Abonné (H)
Certaines de ces adresses concernent les membres d'un couple (une ligne pour chaque membre du couple).
Je cherche à identifier les membres de couples : même Nom (C), même Adresse (D), Civilité (A) différente.
Je voudrais ensuite :
- que si pour l'un des membres du couple la cellule Abonné (H) n'est pas vide et que sa cellule Civilité (A) est égale à M, le M soit remplacé par M et Mme,
- et que si la cellule Civilité (A) est égale à Mme, elle soit remplacée par Mme et M.
- que si pour l'autre membre du couple la cellule Abonné (H) est vide, la ligne soit supprimée.

Pour exemple, si j'ai dans le fichier :
M / Alain / DUPONT / 20 RUE DU PORT /75009 / PARIS / cot/ abt /
Mme / Brigitte / DUPONT / 20 RUE DU PORT / 75009 / PARIS / cot / /
M / Edouard / MACHIN / 153 AVENUE GRAND / 38000 / GRENOBLE / cot / /
Mme / Suzanne / MACHIN / 153 AVENUE GRAND / 38000 / GRENOBLE / cot / abt /

je voudrais que des lignes deviennent !
M et Mme / Alain / DUPONT / 20 RUE DU PORT /75009 / PARIS / cot/ abt /
Mme et M / Suzanne / MACHIN / 153 AVENUE GRAND / 38000 / GRENOBLE / cot / abt /

Un grand merci à ceux qui voudront bien examiner la question.

Homère

[patricktoulon]

bonjour
au plus simple
utilisation de la fonction "find" et "findnext" (vba)
suprimer la ligne apres la premiere et met "m et mme" a la place de la civilité quel qu'elle soit

tout simplement

reste que tu auras 1 chance sur 2 que le prenom soit faux

poste un exemple de ton tableau je te ferait un exemple

au plaisir

[homère]

Merci Patrick,
Cette solution "simple" avancera les choses très sérieusement.
Je joins un fichier test et te remercie encore.
Homère

[mercatog]

Une proposition purement vba

Code :

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
56
57
58
Option Explicit
 
Sub Traiter()
Const MMme As String = "M & Mme"
Const MmeM As String = "Mme & M"
Dim Tb, Res() As String, Ident As String, Conj As String
Dim N As Long, i As Long, j As Long, k As Long, p As Long
Dim IdOk As Boolean, Trouve As Boolean
Dim m As Byte
 
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("Feuil1")
    N = .Cells(.Rows.Count, 1).End(xlUp).Row
    Tb = .Range("A1:I" & N)
    ReDim Res(1 To 8, 1 To 1)
    For m = 1 To 8
        Res(m, 1) = Tb(1, m)
    Next m
    k = 1
    For i = 2 To N - 1
        If IsEmpty(Tb(i, 9)) Then
            Ident = Former(Tb(i, 3)) & "|" & Former(Tb(i, 4))
            For j = i + 1 To N
                If IsEmpty(Tb(j, 9)) Then
                    Conj = Former(Tb(j, 3)) & "|" & Former(Tb(j, 4))
                    If Conj = Ident Then
                        Trouve = True
                        Exit For
                    End If
                End If
            Next j
            If Trouve Then
                IdOk = Tb(i, 8) <> ""
                p = IIf(IdOk, i, j)
            Else
                p = i
            End If
 
            If Tb(p, 8) <> "" Then
                k = k + 1
                ReDim Preserve Res(1 To 8, 1 To k)
                For m = 2 To 8
                    Res(m, k) = Tb(p, m)
                Next m
                Res(1, k) = IIf(Trouve, IIf(Tb(p, 1) = "M", MMme, MmeM), Tb(p, 1))
                Tb(p, 9) = "X"
            End If
        End If
        Trouve = False
    Next i
    .Range("J1").Resize(k, 8) = Application.Transpose(Res)
End With
End Sub
 
Private Function Former(ByVal Str As String) As String
 
Former = UCase(Trim(Str))
End Function