Regels

[xbox360]

Hoi,

Harry heeft mijn al geholpen met het verschil te verwijzen naar een andere tabblad :thumb:
maar ik had een andere klein vraagje
alles afgezocht maar weer niet kunnen vinden
adressen vergelijken werkt perfect alleen is er een klein probleempje
als ik controle nieuwe adressen doe zet hij alles over, maar hij zet het adres in tabblad nieuw op regel 3
omdat in de stamgegevens al 1 adres op regel 2 staat
nu moet ik 72000 adressen controleren, als hij adressen tegen komt die er niet in staat zet hij deze in tabblad nieuwe op regel 72001.
is het mogelijk om deze gewoon op regel 3 te laten beginnen?

Alvast super bedankt

 

[HSV]

Zoiets?
1e verwijderd.

Of:

 Sheets("Nieuw").Cells(Lijst.Count, 1).Offset(1).Resize(, 5) = Sheets(2).Cells(a, 1).Resize(, 5).Value

 

[xbox360]

Raar

heb de regel verandert, maar nu doet en het vergelijken van 2 tabbladen niet meer
en ik krijg 6 deze regels

 

[HSV]

Ik heb het toevallig net aangepast in mijn vorig schrijven.

 

[xbox360]

Gek

RAAR, Nu vergelijk hij de stamgegevens en de import niet meer?
in elke tabblad zit de zelfde adressen en hij blijft aangeven dat ze nieuw zijn?

 

[HSV]

Zo beter?

With Sheets("Nieuw")
           .Cells(Application.Max(3, .Cells(Rows.Count, 1).End(xlUp).Row), 1).Offset(1).Resize(, 5) = Split(Lijst.Item(Lijst.Count))
        End With

 

[xbox360]

Waar?

Mooi, maar waar moet ik deze tussen zetten?

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(3, 1).Resize(Lijst.Count, 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

 

[HSV]

[COLOR=#333333]'als de code nog niet bekend is....[/COLOR]
[COLOR=#333333]If Bekend = False Then[/COLOR]
[COLOR=#333333]'wordt de code toegevoegd aan de verzameling[/COLOR]
[COLOR=#333333]Lijst.Add Join(Application.Index(Sheets(2).Cells(a, 1).Resize(, 5).Value, 1, 0))[/COLOR]
[COLOR=#333333]'wordt de code toegevoegd aand de stamgegevens[/COLOR]
[COLOR=#ff0000]With Sheets("Nieuw")[/COLOR]
[COLOR=#ff0000]   .Cells(Application.Max(3, .Cells(Rows.Count, 1).End(xlUp).Row), 1).Offset(1).Resize(, 5) = Sheets(2).Cells(a, 1).Resize(, 5).Value
End With[/COLOR]
[COLOR=#333333]'wordt de opmaak van de toevoeging vetgedrukt gemaakt om te kunnen zien wat er is toegevoegd[/COLOR]
[COLOR=#333333]Sheets(2).Cells(Lijst.Count + 1, 1).Font.Bold = True[/COLOR]
[COLOR=#333333]'wordt de code toegevoegd aan de teks in een slotmelding[/COLOR]
[COLOR=#333333]Melding = Melding & vbCrLf & Join(Application.Index(Sheets(2).Cells(a, 1).Resize(, 5).Value, 1, 0))[/COLOR]
[COLOR=#333333]End If[/COLOR]

 

[xbox360]

Yes

Thnx,

het werkt :thumb::thumb::thumb: