Vergelijken

[xbox360]

Hoi,

ik ben reeds door harry geholpen met de vba code, maar ik heb nog een klein probleempje en hoop misschien dat iemand hier een oplossing voor weet
in de tabblad stamgegevens en import komen twee adressen lijsten met straatnamen
als ik nu controle adressen doe dan vergelijk hij de twee tabbladen en voeg de nieuwe die niet overeen komen ( dus nieuw )in de tabblad stamgegevens in het bold
is het mogelijk deze in tabblad nieuw te laten komen?
vraagje 2

Insulindeplein 10 5014 BD Tilburg 1
Insulindeplein 20 5014 BD Tilburg 1

als ik deze erin zet als test dan pakt hij 1 Insulindeplein, en neemt de twee met huisnummer 20 niet mee

maar als ik het zo doe wel

Insulindeplein 10
Insulindeplein 20

zie voorbeeld als bijlage

maar dan moet ik de format van de lijst aanpassen die ik erin plak

weet iemand misschien een oplossing?

Alvast weer super bedankt

 

[HSV]

Het is niet mijn code, alleen een oplossing voor je probleem.

 Private Sub CommandButton1_Click()

Dim a, Waarde, Melding, Bekend
Dim Lijst As New Collection


a = 1
'doorloop de reeds bekende codes
Do: a = a + 1
    'zet deze in een verzameling (werkt sneller dan vanaf het Excelblad)
    Lijst.Add Sheets(1).Cells(a, 1)
Loop Until Sheets(1).Cells(a + 1, 1) = ""


a = 1
'doorloop de regels van de import
Do: a = a + 1
    Bekend = False
    'bij elke regel wordt gecontroleerd of de code al in de verzameling staat
    For b = 1 To Lijst.Count
    
        If Join(Application.Index(Sheets(2).Cells(a, 1).Resize(, 5).Value, 1, 0)) = Lijst(b) Then Bekend = True
    Next b
    
    'als de code nog niet bekend is....
    If Bekend = False Then
        'wordt de code toegevoegd aan de verzameling
        Lijst.Add Join(Application.Index(Sheets(2).Cells(a, 1).Resize(, 5).Value, 1, 0))
        'wordt de code toegevoegd aand de stamgegevens
        Sheets("Nieuw").Cells(Lijst.Count + 1, 1).Resize(, 5) = Sheets(2).Cells(a, 1).Resize(, 5).Value
        'wordt de opmaak van de toevoeging vetgedrukt gemaakt om te kunnen zien wat er is toegevoegd
        Sheets(2).Cells(Lijst.Count + 1, 1).Font.Bold = True
        'wordt de code toegevoegd aan de teks in een slotmelding
        Melding = Melding & vbCrLf & Join(Application.Index(Sheets(2).Cells(a, 1).Resize(, 5).Value, 1, 0))
    End If
    
Loop Until Sheets(2).Cells(a + 1, 1) = ""


'slot melding
If Melding <> "" Then
    MsgBox "De volgende Adressen zijn nieuw in de import lijst" & Melding
Else
    MsgBox "Er zijn geen nieuwe Adressen gevonden"
End If
End Sub

 

[xbox360]

Thnx

Harry,
je bent geweldig.........

Super bedankt...