créer une nouvelle bdd a partir de deux bdd

[matsurf]

Bonjour,
voici mon problème:

j'ai une feuille A avec des contacts
J'ai une feuille B avec d'autres contacts + des contacts de la feuille A

Je souhaiterais créer une feuille C avec les contacts de la feuille B sans les contacts de la feuille A


Y a t'il un moyen?

En pj un extrait de la bdd


Merci pour votre aide

 

[Efgé]

Re : créer une nouvelle bdd a partir de deux bdd

Bonjour matsurf,
Juste pour l'exercice j'ai fait quelque chose sous 2003 mais je pense que ce sera valable pour 2007.
Deux prérequis:
- Le nombre de lignes cumulé des deux bases ne doit pas exéder le nombre de lignes total de l'application
- Les cellules en colonnes A doivent toutes être renseignées

Je n'ai pas testé mais je pense qu'il y a un avantage: si le traitement se fait sur plusieur milliers de lignes, tu aura le temps de boire un café, pour plusieur dixaines de milliers, tu pourra aller déjeuner 😉

[COLOR=blue]Private Sub[/COLOR] CommandButton1_Click()
Application.ScreenUpdating = [COLOR=blue]False[/COLOR]
Derlign = Sheets("bdd A").Range("A" & Application.Rows.Count).End(xlUp).Row
Derlign2 = Sheets("bdd B").Range("A" & Application.Rows.Count).End(xlUp).Row
Derlign3 = Derlign + Derlign2 - 1
[COLOR=blue]With[/COLOR] Sheets("bdd c")
    [COLOR=blue]If[/COLOR] .Range("A2") <> "" [COLOR=blue]Then[/COLOR] .Range("A2:J" & .Range("A" & Application.Rows.Count).End(xlUp).Row).ClearContents
 
    Sheets("bdd A").Rows("2 : " & Derlign).Copy Destination:=.Range("A2")
    .Range("K2:K" & Derlign) = "A"
 
     Sheets("bdd B").Rows("2 : " & Derlign2).Copy Destination:=.Range("A" & Derlign + 1)
    .Range("K" & Derlign + 1 & ":K" & Derlign3) = "B"
 
    .Range("L2:L" & Derlign3).FormulaLocal = "=SOMMEPROD(($A$2:$A$" & Derlign3 & "=$A2)*($K$2:$K$" & Derlign3 & "=""A"")*1)"
 
    [COLOR=blue]For[/COLOR] i = Derlign3 [COLOR=blue]To[/COLOR] 1 [COLOR=blue]Step[/COLOR] -1
        [COLOR=blue]If[/COLOR] .Cells(i, 12).Value <> 0 [COLOR=blue]Then[/COLOR] .Rows(i).Delete
    [COLOR=blue]Next[/COLOR] i
 
    .Columns("K:L").ClearContents
    .Activate
[COLOR=blue]End With[/COLOR]
Application.ScreenUpdating = [COLOR=blue]True[/COLOR]
[COLOR=blue]End Sub[/COLOR]

J'attend de voir d'autres méthodes qui seront certainement meilleures
Cordialement

 

[mromain]

Re : créer une nouvelle bdd a partir de deux bdd

Bonjour matsurf, Efgé 😉

Voici un autre essai :

Sub Test()
Dim zoneA As Excel.Range, zoneB As Excel.Range, curCell As Excel.Range, iL As Long

    With ThisWorkbook.Sheets("bdd A")
        Set zoneA = .Range("K2:K" & .Range("A" & .Rows.Count).End(xlUp).Row)
    End With
    
    With ThisWorkbook.Sheets("bdd B")
        Set zoneB = .Range("K2:K" & .Range("A" & .Rows.Count).End(xlUp).Row)
    End With
    
    zoneA.FormulaR1C1 = "=RC1&""|""&RC2&""|""&RC3&""|""&RC4&""|""&RC5&""|""&RC6&""|""&RC7&""|""&RC8&""|""&RC9&""|""&RC10"
    zoneA.Value = zoneA.Value
    zoneB.FormulaR1C1 = "=RC1&""|""&RC2&""|""&RC3&""|""&RC4&""|""&RC5&""|""&RC6&""|""&RC7&""|""&RC8&""|""&RC9&""|""&RC10"
    zoneB.Value = zoneB.Value
    
    iL = 1
    With ThisWorkbook.Sheets("bdd C")
        For Each curCell In zoneB
            If zoneA.Find(curCell.Text, , xlValues, xlWhole) Is Nothing Then
                iL = iL + 1
                .Range("A" & iL) = curCell.Text
            End If
        Next curCell
        If iL <> 1 Then
            .Range("A2:A" & iL).TextToColumns Destination:=.Range("A2"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
                Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
                :="|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
                1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), _
                TrailingMinusNumbers:=True
        End If
    End With
    
    zoneA.Clear
    zoneB.Clear
End Sub

a+

 

[Efgé]

Re : créer une nouvelle bdd a partir de deux bdd

Re matsurf, Bonjour mromain🙂,
mromain, merci pour cet exemple. Je n'avais jamais croisé cette méthode.
Par contre j'y trouve un inconvénient : même pour des dixaines de milliers de lignes, notre ami matsurf ne pourra plus trouver d'excuses pour aller boire un café 😀.
Encore merci pour ce code.
Cordialement

 

[mromain]

Re : créer une nouvelle bdd a partir de deux bdd

Re,

matsurf ne pourra plus trouver d'excuses pour aller boire un café 😀.

😀

Un petit Application.Wait peux sûrement arranger ça !
Je laisse matsurf gérer ce problème 😉

a+