probleem vergelijking cellen in 2 excelsheets

**SierraGT** · 2 april 2012, 11:00

Ik wil proberen in VBA een vergelijking te maken van gegevens die op 2 sheets staan. en de uitkomst in een derde sheet te plaatsen.

Ik heb dus 2 lijsten: sheet 1 & sheet 2 met daarop allerlei gegevens.
sheet 1 wordt elke keer vernieuwd door import van een tekstbestand.
sheet 2 is de vorige versie van sheet 1.

nu wil ik op sheet 3, de volledige rij kopiëren welke een verschil bevat.

omdat er ook nieuwe regels in het import bestand kunnen zitten, moet de vergelijking eerst naar de waarde in kolom A sheet1 kijken, dan de waarde in sheet2 kolom A opzoeken en deze rij dan vergelijken.

zit er dan een verschil in de rij, dan moet deze rij in sheet 3 geplaatst worden....

Nu ben ik een noob in VBA, dus misschien kunnen jullie me een beetje in de juiste richting helpen?
ik heb wat dingen geprobeerd met if then lussen, maar ik krijg niet de gewenste uitkomst.....

bijgaand het stukkie wat ik nu aan import heb....

**RvanGalenLast** · 2 april 2012, 16:31

Probeer de onderstaande code eens. De gegevens waar de verschillen in zitten worden allebei naar het tabblad "uitkomst" gekopieerd.

Ik weet niet hoeveel records er uiteindelijk in de import terecht kunnen komen maar als dat er meer dan 65536 worden dan moet je de variabelen i, j etc als long dimmen.

Code:

Sub Vergelijken()
Dim i, j, Lr1, Lr2 As Integer
Dim p, q As String
Dim r As Range
    Sheets("uitkomst").Cells.ClearContents
    Sheets("import").Activate
    Lr1 = Sheets("import").[a65536].End(xlUp).Row
    Lr2 = Sheets("vorigelijst").[a65536].End(xlUp).Row
    Set r = Sheets("vorigelijst").Range("A1:A" & Lr2)
    For i = 1 To Lr1
        j = r.Find(what:=Sheets("import").Cells(i, 1)).Row
        p = Sheets("import").Cells(i, 1) & Sheets("import").Cells(i, 2) & Sheets("import").Cells(i, 3)
        q = Sheets("vorigelijst").Cells(j, 1) & Sheets("vorigelijst").Cells(j, 2) & Sheets("vorigelijst").Cells(j, 3)
        If p <> q Then
            Range(Cells(i, 1), Cells(i, 3)).Copy (Sheets("uitkomst").[a65536].End(xlUp).Offset(1))
            Range(Sheets("vorigelijst").Cells(j, 1), Sheets("vorigelijst").Cells(j, 3)).Copy (Sheets("uitkomst").[d65536].End(xlUp).Offset(1))
        End If
    Next
End Sub

**SierraGT** · 2 april 2012, 17:29

thnx....

ik ga vanavond wel even puzzelen!!!

**SierraGT** · 3 april 2012, 08:13

Hij werkt uitstekend!! zelfs als ik de waarden door elkaar gooi....
echter nog 1 klein probleempje;

op de pagina 'import' kan het zijn als er nieuwe artikelen ingevoerd zijn, dat de import lijst langer is dan de 'oude' lijst.
als ik dit doe, krijg ik de volgende foutmelding:

'fout 91 tijdens uitvoering.
objectvariabele of blokvariabele With is niet ingesteld.

Code:

Dim i, j, Lr1, Lr2 As Integer
Dim p, q As String
Dim r As Range
    Sheets("uitkomst").Cells.ClearContents
    Sheets("import").Activate
    Lr1 = Sheets("import").[a65536].End(xlUp).Row
    Lr2 = Sheets("vorigelijst").[a65536].End(xlUp).Row
    Set r = Sheets("vorigelijst").Range("A1:A" & Lr2)
    For i = 1 To Lr1
        j = r.Find(what:=Sheets("import").Cells(i, 1)).Row
        p = Sheets("import").Cells(i, 1) & Sheets("import").Cells(i, 2) & Sheets("import").Cells(i, 3)
        q = Sheets("vorigelijst").Cells(j, 1) & Sheets("vorigelijst").Cells(j, 2) & Sheets("vorigelijst").Cells(j, 3)
        If p <> q Then
            Range(Cells(i, 1), Cells(i, 3)).Copy (Sheets("uitkomst").[a65536].End(xlUp).Offset(1))
            Range(Sheets("vorigelijst").Cells(j, 1), Sheets("vorigelijst").Cells(j, 3)).Copy (Sheets("uitkomst").[d65536].End(xlUp).Offset(1))
        End If
    Next

dit geeft ie aan bij de rode regel...

Nieuwe artikelen op de import lijst moeten eigenlijk ook naar de 'uitkomstpagina' geplaatst worden, of naar een 2e pagina 'uitkomst2'
is dat een probleem? Dus eigenlijk gewoon de rijen waarvan de waarde in kolom A nog niet voorkomen in de 'vorige lijst'.

Tot op heden bedankt voor je hulp, hier was ik nooit uitgekomen!!

**Niels28** · 3 april 2012, 09:41

Code:

 Set j = r.Find(what:=Sheets("import").Cells(i, 1))
     j = j.Row

Niels

**Warme bakkertje** · 3 april 2012, 10:04

Code:

Dim i, j, Lr1, Lr2 As Integer
Dim p, q As String

Dit is een klassieke beginnersfout bij het declareren van variabelen.
Elke variabele moet apart gedeclareerd worden anders krijgt hij gegevenstype Variant.
Op de eerste rij krijg je dus 3 varianten en 1 integer, op regel 2 1 variant en 1 string, terwiijl je 4 Integers en 2 Strings wilde.
Op zich geeft geen probleem, alleen dat Varianten meer geheugenruimte innemen.
Dit is de correcte manier

Code:

Dim i As Integer, j As Integer, Lr1 As Integer, Lr2 As Integer
Dim p As String, q As String

**RvanGalenLast** · 3 april 2012, 10:14

Rudi,

Bedankt voor de tip! Ik heb tot nu toe altijd zo gewerkt met het declareren van variabelen en ben ook niet eerder tegen dergelijke problemen aangelopen.

Dit zou het probleem dan moeten oplossen voor SierraGT.

**Warme bakkertje** · 3 april 2012, 22:09

Dat niet, maar onderstaande wel.

Code:

Sub Vergelijken()
Dim i As Integer, j As Variant, Lr1 As Integer, Lr2 As Integer
Dim p As String, q As String, r As Range
    Sheets("uitkomst").Cells.ClearContents
    With Sheets("import")
        Lr1 = .[a65536].End(xlUp).Row
        Lr2 = Sheets("vorigelijst").[a65536].End(xlUp).Row
        Set r = Sheets("vorigelijst").Range("A1:A" & Lr2)
            For i = 1 To Lr1
                Set j = r.Find(what:=.Cells(i, 1))
                If Not j Is Nothing Then
                    j = j.Row
                    p = .Cells(i, 1) & .Cells(i, 2) & .Cells(i, 3)
                    q = Sheets("vorigelijst").Cells(j, 1) & Sheets("vorigelijst").Cells(j, 2) & Sheets("vorigelijst").Cells(j, 3)
                    If p <> q Then
                        .Range(.Cells(i, 1), .Cells(i, 3)).Copy (Sheets("uitkomst").[a65536].End(xlUp).Offset(1))
                        Range(Sheets("vorigelijst").Cells(j, 1), Sheets("vorigelijst").Cells(j, 3)).Copy (Sheets("uitkomst").[d65536].End(xlUp).Offset(1))
                    End If
                Else
                    .Range(.Cells(i, 1), .Cells(i, 3)).Copy (Sheets("uitkomst").[a65536].End(xlUp).Offset(1))
                End If
            Next
    End With
End Sub

**SierraGT** · 10 april 2012, 08:43

Sorry, beetje late reactie, maar mijn dank is groot...

voor zover ik nu kan zien, doet hij precies wat ik voor ogen had...
thnx. voor de hulp, ik was hier nooit alleen uitgekomen...

**SierraGT** · 10 april 2012, 09:10

even een korte vraag.

ik heb even een proefje gedaan met het aanpassen van het aantal kolommen wat vergeleken moet worden, van 3 naar 10....
eigenlijk moeten dat in de toekomst ongeveer 20 gaan worden, maar daar gaat het even niet om..

wat voor een effect heeft de rode regel eigenlijk, aangezien deze als resultaat (nu) nog een keer de regel met een afwijkende waarde vanaf kolom D neerzet???

Code:

   
Dim i As Integer, j As Variant, Lr1 As Integer, Lr2 As Integer
Dim p As String, q As String, r As Range
    Sheets("uitkomst").Cells.ClearContents
    With Sheets("import")
        Lr1 = .[a65536].End(xlUp).Row
        Lr2 = Sheets("vorigelijst").[a65536].End(xlUp).Row
        Set r = Sheets("vorigelijst").Range("A1:A" & Lr2)
            For i = 1 To Lr1
                Set j = r.Find(what:=.Cells(i, 1))
                If Not j Is Nothing Then
                    j = j.Row
                    p = .Cells(i, 1) & .Cells(i, 2) & .Cells(i, 3) & .Cells(i, 4) & .Cells(i, 5) & .Cells(i, 6) & .Cells(i, 7) & .Cells(i, 8) & .Cells(i, 9) & .Cells(i, 10)
                                        
                    q = Sheets("vorigelijst").Cells(j, 1) & Sheets("vorigelijst").Cells(j, 2) & Sheets("vorigelijst").Cells(j, 3) & Sheets("vorigelijst").Cells(j, 4) & Sheets("vorigelijst").Cells(j, 5) & Sheets("vorigelijst").Cells(j, 6) & Sheets("vorigelijst").Cells(j, 7) & Sheets("vorigelijst").Cells(j, 8) & Sheets("vorigelijst").Cells(j, 9) & Sheets("vorigelijst").Cells(j, 10)
                                        If p <> q Then
                        .Range(.Cells(i, 1), .Cells(i, 10)).Copy (Sheets("uitkomst").[a65536].End(xlUp).Offset(1))
                        Range(Sheets("vorigelijst").Cells(j, 1), Sheets("vorigelijst").Cells(j, 4)).Copy (Sheets("uitkomst").[d65536].End(xlUp).Offset(1))
                    End If
                Else
                    .Range(.Cells(i, 1), .Cells(i, 10)).Copy (Sheets("uitkomst").[a65536].End(xlUp).Offset(1))
                End If
            Next
    End With

en is deze manier wel een goede manier om het aantal kolommen te vergroten? of gaat me dat veel geheugen c.q. rekenkracht kosten?

**snb** · 10 april 2012, 09:33

Het kan ook zo (waarschijnlijk veel sneller; en geen zorgen over de declaratie van variabelen)

Code:

Sub Vergelijken()
  sn = Sheets("import").Cells(1).CurrentRegion
  sq = Sheets("vorigelijst").Cells(1).CurrentRegion
    
  For j = 1 To UBound(sn)
    c01 = c01 & "|" & Join(Application.Index(sn, j))
  Next
  For j = 1 To UBound(sq)
    If InStr("|" & c01 & "|", "|" & Join(Application.Index(sq, j)) & "|") = 0 Then c02 = c02 & "|" & j
  Next
  st = Split(Mid(c02, 2), "|")
    
  With Sheets("uitkomst")
    .Cells.ClearContents
    .Cells(1).Resize(UBound(st) + 1, UBound(sn, 2)) = Application.Index(sn, Application.Transpose(st), Array(1, 2, 3))
  End With
End Sub

**SierraGT** · 10 april 2012, 09:42

hmmm.. met deze code krijg ik al resultaat alleen het volledige bereik van A1 tot C6?????

**snb** · 10 april 2012, 10:00

Daar geloof ik niet veel van.
Zie de bijlage; met deze code:

Code:

Sub Vergelijken()
  sn = Sheets("import").Cells(1).CurrentRegion
  sq = Sheets("vorigelijst").Cells(1).CurrentRegion
    
  With New Dictionary
    For j = 1 To UBound(sn)
      .Add Join(Application.Index(sn, j)), ""
    Next

    For j = 1 To UBound(sq)
      If Not .Exists(Join(Application.Index(sq, j))) Then c02 = c02 & "|" & j
    Next
  End With
  st = Split(Mid(c02, 2), "|")
    
  With Sheets("uitkomst")
    .Cells.ClearContents
    .Cells(1).Resize(UBound(st) + 1, UBound(sn, 2)) = Application.Index(sn, Application.Transpose(st), Array(1, 2, 3))
  End With
End Sub

NB. verwijzing naar Microsoft Scripting Runtime activeren (VBEditor/menubalk/extra/verwijzingen..)

**SierraGT** · 10 april 2012, 11:39

als ik nu deze formule erop los laat, krijg ik inderdaad de regels die afwijken in het tabblad 'uitkomst.'

maar... rij nummer 3 wordt ook ten alle tijden naar 'uitkomst' gezet. als zijnde afwijkend.
ook krijg ik geen respons als ik bij 'import' een nieuwe rij met waarden wordt toegevoegd....

het lastigste is volgens mij dat het blad met 'import' totaal andere gegevens kan bevatten dan de 'vorige' lijst.
ook aanvullingen in nieuwe rijen. Het enige wat stabiel blijft is het aantal kolommen....

verplaats ik nu een rij; b.v. rij 3 knippen, en plakken op rij 6, krijg ik een lijst met allemaal verwijzingsfouten....
Deze gegevens zijn nu even een test, maar dit zou straks moeten gebeuren met zo'n 10.000 artikel gegevens......

**snb** · 10 april 2012, 12:17

Ik denk niet dat het duidelijk is over welke aanpak je het hebt.
Je moet de code wel aanpassen aan het aantal kolommen:

Bij 10 kolommen:

Array(1, 2, 3,4,5,6,7,8,9,10)

of eenvoudiger:

Code:

[transpose(row(1:10))]

bij 20 kolommen:

Code:

[transpose(row(1:20))]

**SierraGT** · 10 april 2012, 12:31

hmmm... in excel 2003 krijg ik wel een verwijzingsfout, maar met 2010 niet...

Ik heb jou testbestandje gebruikt snb, en dat werkt nu wel, echter registreert hij geen nieuwe regels.
bij de uitkomst, moet ook de nieuwe regels die niet in de vorige lijst voorkwamen naar 'uitkomst' geplaatst worden.

de importlijst kan nieuwe regels bevatten die overal tussengevoegd kunnen zijn... en deze regels moeten ook naar 'uitkomst' gekopieerd worden....

en is jou code makkelijk aan te passen naar 20 kolommen vergelijken? De vorige code kon ik nog een klein beetje uit wijs worden, maar dit gaat mijn pet een beetje te boven....

**snb** · 10 april 2012, 13:02

Onafhankelijk van het aantal kolommen:

Code:

Sub Vergelijken_snb_002()
  sq = Sheets("vorigelijst").Cells(1).CurrentRegion
  sn = Sheets("import").Cells(1).CurrentRegion
    
  With New Dictionary
    For j = 1 To UBound(sq)
      .Add Join(Application.Index(sq, j)), ""
    Next

    For j = 1 To UBound(sn)
      If Not .Exists(Join(Application.Index(sn, j))) Then c02 = c02 & "|" & j
    Next
  End With
  
  st = Split(Mid(c02, 2), "|")
    
  With Sheets("uitkomst")
    .Cells.ClearContents
    .Cells(1).Resize(UBound(st) + 1, UBound(sq, 2)) = Application.Index(sn, Application.Transpose(st), Evaluate("transpose(row(1:" & UBound(sn, 2) & "))"))
  End With
End Sub

**SierraGT** · 13 april 2012, 08:34

Dit gaat helemaal goed
komen....
bedankt allemaal!

**SierraGT** · 15 mei 2012, 13:40

ik heb nu onderstaand (gestript) excel bestand.

deze werkt prima, en vergelijkt nu alle kolommen en rijen van blad1 en blad2...
uitkomst komt op blad 3.

Kan ik deze code makkelijk aanpassen zodat ik bijvoorbeeld alleen kan vergelijken op kolom 1,3,5,6 o.i.d.???
dan moet dus de uitkomst alleen gekopieerd worden als waardes veranderen in een paar van te voren opgegeven kolommen....

de kolom nummers zijn nog niet bekend....

vergelijk3 - kopie.zip

**huijb** · 11 maart 2013, 17:06

@emoes Vraag verwijderd. Graag een eigen vraag maken. Het is niet toegestaan in iemand anders zijn vraag jouw probleem te plaatsen. Dit is onoverzichtelijk voor de helpers maar vooral voor de topicstarter.

Onderwerp: probleem vergelijking cellen in 2 excelsheets

Onderwerp opties

Zoek in onderwerp

Vraag is opgelost

probleem vergelijking cellen in 2 excelsheets

beetje late reactie...

toch nog een aanpassing....

toch nog even een aanvulling....

Berichtenregels

Helpmij.nl

Helpmij.nl en business

Contact