• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Vergelijken twee workbooks met VBA

Status
Niet open voor verdere reacties.
HWV

HWV

Terugkerende gebruiker
Lid geworden
19 feb 2009
Berichten
1.183
Beste,

Ik heb twee workbooks die ik wil vergelijken op wijzigingen.
In totaal heb ik nu drie workbooks gemaakt

- het orginele bestand
- Het bestand met de wijzigingen
- en de sheet zoals in de bijlage waar ik enkel maar de wijzigingen in wil hebben

Ik heb nu in de workbook waar ik de wijzigingen in wil hebben in elke kolom een formule staan:
Code: 
=ALS('[locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls]Blad1'!A4='[locaties Pick-Bulk Artikel eenheid Min Max Zone Controle orgineel.xls]Blad1'!A4;"";'[locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls]Blad1'!A4)

Dit geld van Kolom A tm P, en dan tot regel 4000.

In de bijlage het bestand waar ik de wijzigingen in wil hebben. Alle drie de lijsten hebben het zelfde format.
Kan ik dit ook doen met VBA, zodra er een wijziging is in het bestand :

"locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV"
plaats is gevonden dat ik dit met vba kan opvragen in de sheet
"locaties Pick-Bulk Artikel eenheid Min Max Zone Controle verwerking henk"

Ik hoor graag of er een ander mogelijkhied is hiervoor

groet HWV
 

Bijlagen

  • locaties Pick-Bulk Artikel eenheid Min Max Zone Controle verwerking henk.xls
    30 KB · Weergaven: 48
een deel wel maar niet helemaal

Code: 
Sub Vergelijk()

For i = 4 To Range("A65000").End(xlUp).Row
    If Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle orgineel.xls").Sheets("Blad1").Cells(i, 2) [COLOR="Red"]>[/COLOR] Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, 2) Then
    Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle verwerking henk.xls").Sheets("Blad1").Cells(i, 2) = Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, 2).Value
    End If
Next i

End Sub

Ik heb het al aardig voor elkaar, maar toch net niet helemaal, nu met de groterdan teken gaat het goed maar dan moet het wel groter zijn ik heb het al geprobeerd met de <> is gelijk teken maar dat wil niet lukken iemand een idee waar het aan kan liggen.

groet HWV
 
HWV zei:
Code: 
Sub Vergelijk()

For i = 4 To Range("A65000").End(xlUp).Row
    If Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle orgineel.xls").Sheets("Blad1").Cells(i, 2) [COLOR="Red"]>[/COLOR] Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, 2) Then
    Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle verwerking henk.xls").Sheets("Blad1").Cells(i, 2) = Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, 2).Value
    End If
Next i

End Sub

Ik heb het al aardig voor elkaar, maar toch net niet helemaal, nu met de groterdan teken gaat het goed maar dan moet het wel groter zijn ik heb het al geprobeerd met de <> is gelijk teken maar dat wil niet lukken iemand een idee waar het aan kan liggen.

groet HWV
Klik om te vergroten...

Waarom werk ongelijk aan (<>) dan niet. Wat gebeurt er dan?

Ron
 
Code: 
Sub Vergelijk()

For i = 4 To Range("A65000").End(xlUp).Row
    If Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle orgineel.xls").Sheets("Blad1").Cells(i, 2) <> Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, 2) Then
    Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle verwerking henk.xls").Sheets("Blad1").Cells(i, 2) = Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, 2).Value
    End If
Next i

End Sub

Nu snap ik niks meer van Excel, mijn pc opnieuw opgestart en nu doet hij het wel.

Om de kolomen tevergelijken moet ik dit dan per kolom gaan invoeren :

Code: 
Sub Vergelijk()

For i = 4 To Range("A65000").End(xlUp).Row
    If Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle orgineel.xls").Sheets("Blad1").Cells(i, 2) <> Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, 2) Then
    Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle verwerking henk.xls").Sheets("Blad1").Cells(i, 2) = Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, 2).Value
    End If
Next i
For i = 4 To Range("A65000").End(xlUp).Row
    If Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle orgineel.xls").Sheets("Blad1").Cells(i, 3) <> Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, 3) Then
    Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle verwerking henk.xls").Sheets("Blad1").Cells(i, 3) = Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, 3).Value
    End If
Next i
For i = 4 To Range("A65000").End(xlUp).Row
    If Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle orgineel.xls").Sheets("Blad1").Cells(i, 4) <> Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, 4) Then
    Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle verwerking henk.xls").Sheets("Blad1").Cells(i, 4) = Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, 4).Value
    End If
Next i
For i = 4 To Range("A65000").End(xlUp).Row
    If Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle orgineel.xls").Sheets("Blad1").Cells(i, 6) <> Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, 6) Then
    Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle verwerking henk.xls").Sheets("Blad1").Cells(i, 6) = Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, 6).Value
    End If
Next i
For i = 4 To Range("A65000").End(xlUp).Row
    If Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle orgineel.xls").Sheets("Blad1").Cells(i, 8) <> Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, 8) Then
    Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle verwerking henk.xls").Sheets("Blad1").Cells(i, 8) = Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, 8).Value
    End If
Next i
For i = 4 To Range("A65000").End(xlUp).Row
    If Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle orgineel.xls").Sheets("Blad1").Cells(i, 10) <> Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, 10) Then
    Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle verwerking henk.xls").Sheets("Blad1").Cells(i, 10) = Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, 10).Value
    End If
Next i
For i = 4 To Range("A65000").End(xlUp).Row
    If Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle orgineel.xls").Sheets("Blad1").Cells(i, 12) <> Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, 12) Then
    Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle verwerking henk.xls").Sheets("Blad1").Cells(i, 12) = Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, 12).Value
    End If
Next i
For i = 4 To Range("A65000").End(xlUp).Row
    If Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle orgineel.xls").Sheets("Blad1").Cells(i, 14) <> Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, 14) Then
    Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle verwerking henk.xls").Sheets("Blad1").Cells(i, 14) = Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, 14).Value
    End If
Next i
For i = 4 To Range("A65000").End(xlUp).Row
    If Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle orgineel.xls").Sheets("Blad1").Cells(i, 15) <> Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, 15) Then
    Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle verwerking henk.xls").Sheets("Blad1").Cells(i, 15) = Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, 15).Value
    End If
Next i
For i = 4 To Range("A65000").End(xlUp).Row
    If Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle orgineel.xls").Sheets("Blad1").Cells(i, 16) <> Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, 16) Then
    Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle verwerking henk.xls").Sheets("Blad1").Cells(i, 16) = Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, 16).Value
    End If
Next i
End Sub

Het werkt wel, maar kan ongetwijfeld korter.

Gr Henk
 
Het wordt al korter als je voor de kolommen ook in een tellertje zet

Code: 
for i=1 to ??
  for j=1 to ??

Ik ben niet zo'n super programmeur, wellicht kan het nog slimmer allemaal. Wie???

Ron
 
Krijg het niet gedaan

Code: 
For j = 2 To Range("A:Q")
For i = 4 To Range("A65000").End(xlUp).Row
    If Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle orgineel.xls").Sheets("Blad1").Cells(i, j) <> Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, j) Then
    Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle verwerking henk.xls").Sheets("Blad1").Cells(i, j) = Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, j).Value
    End If
Next i
Next

Ben er mee bezig maar loop hierin vast.
De lange code werkt wel , maar ben wel benieuwd of dit dus ook korter kan om er van te leren.
Ik zie iets over het hoofd maar wat.

groet HWV
 
Thanks

Thanks,

Dit was de druppel die de emmer doet overlopen, ik zat te moeilijk te denken.

Bedankt allemaal voor de hulp vandaag.

groet HWV
 
nu de lijsten samenvoegen

Ik heb de code zoals ik hem nu heb hieronder geplaatst.

Maar nu loop ik tegen het volgende aan.

De wijzigingen hebben ze in twee indentieke lijsten zitten wijzigen."locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls"

Nu zou ik graag willen dat de lijsten in elkaar geweven kunnen worden tot één lijst.

Dus de verschillen uit beiden lijsten halen, deze samen voegen en dan weer met de orginele lijst samenvoeg ?

Kan iemand mij hier ondersteunen, want nu snap ik iet meer hoe ik het oor elkaar moet krijgen.


Code: 
Sub Vergelijk()

Workbooks.Open "G:\Automatisering\Infomat Project2\Conversie\ZNP\Hulp programma`s\Controle door ZNP bestanden\Locatie eenheden min - max voorkeur pick\locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls"
Workbooks.Open "G:\Automatisering\Infomat Project2\Conversie\ZNP\Hulp programma`s\Controle door ZNP bestanden\Locatie eenheden min - max voorkeur pick\locaties Pick-Bulk Artikel eenheid Min Max Zone Controle orgineel.xls"
Windows("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle verwerking henk.xls").Activate
  
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.StatusBar = "Even geduld, de macro is de lijsten aan het vergelijken, en de verschillen zal hij tonen!"

For j = 2 To 16
For i = 4 To Range("A65000").End(xlUp).Row
    If Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle orgineel.xls").Sheets("Blad1").Cells(i, j) <> Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, j) Then
    Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle verwerking henk.xls").Sheets("Blad1").Cells(i, j) = Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle 28-12-2009 HWV.xls").Sheets("Blad1").Cells(i, j).Value
    End If
Next i
Next

For i = 4 To Range("A65000").End(xlUp).Row
If Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle verwerking henk.xls").Sheets("Blad1").Cells(i, 3) = "" Then
   Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle verwerking henk.xls").Sheets("Blad1").Cells(i, 3) = Workbooks("locaties Pick-Bulk Artikel eenheid Min Max Zone Controle orgineel.xls").Sheets("Blad1").Cells(i, 3).Value
    End If
Next i

Application.ScreenUpdating = True
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar

End Sub

Groet HWV
 
Laatst bewerkt:
Gelukt

Beste,

Ik heb even een test gemaakt voor dat ik het op het orginele bestand los laat :)

Met onderstaande code heb ik het voor elkaar gekregen.
Ik heb de IF ELSE in 4 gedeelte`s moeten zetten, waarschijnlijk is dit ook nog korter te maken.

Voorlopig werkt het naar behoren.
Code: 
Sub Vergelijk()

Workbooks.Open "C:\Documents and Settings\hverschoor\Desktop\Helpmij\test\map1.xls"
Workbooks.Open "C:\Documents and Settings\hverschoor\Desktop\Helpmij\test\map2.xls"
Workbooks.Open "C:\Documents and Settings\hverschoor\Desktop\Helpmij\test\orgineel.xls"
Windows("map3.xls").Activate
  
For j = 2 To 16
For i = 4 To Range("A65000").End(xlUp).Row
    If Workbooks("orgineel.xls").Sheets("Blad1").Cells(i, j) <> Workbooks("map1.xls").Sheets("Blad1").Cells(i, j) Then
    Workbooks("map3.xls").Sheets("Blad1").Cells(i, j) = Workbooks("map1.xls").Sheets("Blad1").Cells(i, j).Value
    Else
    If Workbooks("Orgineel.xls").Sheets("Blad1").Cells(i, j) <> Workbooks("map2.xls").Sheets("Blad1").Cells(i, j) Then
    Workbooks("map3.xls").Sheets("Blad1").Cells(i, j) = Workbooks("map2.xls").Sheets("Blad1").Cells(i, j).Value
    Else
    If Workbooks("Orgineel.xls").Sheets("Blad1").Cells(i, j) = Workbooks("map1.xls").Sheets("Blad1").Cells(i, j) Then
    Workbooks("map3.xls").Sheets("Blad1").Cells(i, j) = Workbooks("Orgineel.xls").Sheets("Blad1").Cells(i, j).Value
    Else
    If Workbooks("Orgineel.xls").Sheets("Blad1").Cells(i, j) = Workbooks("map2.xls").Sheets("Blad1").Cells(i, j) Then
    Workbooks("map3.xls").Sheets("Blad1").Cells(i, j) = Workbooks("Orgineel.xls").Sheets("Blad1").Cells(i, j).Value
    End If
    End If
    End If
    End If
Next i
Next

End Sub

Groet HWV
 
Te vroeg gejuigd

Beste,

Ik loop tegen het volgende aan.
Als er in de twee mappen die ik aan het vergelijken ben met het orgineel zowel in map 1 als map 2 de zelfde cel gewijzigd is, zou ik eigenlijk willen dat deze cel geel gekleurd wordt zodat ik deze dan handmatig kan controleren welke lijst ik dan moet gaan aan houden.

Kunnen jullie mij hier in ondersteunen AUB

Groet HWV
 
Opgelost

Voor die het nog wil weten ik heb het zo op gelost:

If map1 <> is aan orgineel and Map2 <> is aan orgineel and map 1 <> map2 then map 3 = VERSCHIL

If cel is verschil then copy regel en verplaats naar "tabblad verschil"

Code: 
Sub tst1()

For j = 2 To 16
For i = 4 To Range("A65000").End(xlUp).Row

    If Workbooks("map1.xls").Sheets("Blad1").Cells(i, j) <> Workbooks("orgineel.xls").Sheets("Blad1").Cells(i, j) And Workbooks("map2.xls").Sheets("Blad1").Cells(i, j) <> Workbooks("orgineel.xls").Sheets("Blad1").Cells(i, j) And Workbooks("map2.xls").Sheets("Blad1").Cells(i, j) <> Workbooks("map1.xls").Sheets("Blad1").Cells(i, j) Then
    Workbooks("map3.xls").Sheets("Blad1").Cells(i, j) = "VERSCHIL"
    End If
Next i
Next

Sheets("Blad1").Select
   Dim c As Range
   For Each c In [B1:Z10000]
        If c = "VERSCHIL" Then
            c.Rows.EntireRow.Copy
            ['VERSCHIL'!A65536].End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next
End Sub

Als de verschillen handmatig zijn gecontroleerd draai ik het volgende script zodat ik de twee lijsten helemaal compleet krijg met alle wijzigingen in één nieuw blad.
Code: 
Sub Vergelijk()

Workbooks.Open "C:\Documents and Settings\hverschoor\Desktop\Helpmij\test\map1.xls"
Workbooks.Open "C:\Documents and Settings\hverschoor\Desktop\Helpmij\test\map2.xls"
Workbooks.Open "C:\Documents and Settings\hverschoor\Desktop\Helpmij\test\orgineel.xls"
Windows("map3.xls").Activate
  
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.StatusBar = "Even geduld, de macro is de lijsten aan het vergelijken, en de verschillen zal hij tonen!"

For j = 2 To 16
For i = 4 To Range("A65000").End(xlUp).Row
    If Workbooks("orgineel.xls").Sheets("Blad1").Cells(i, j) <> Workbooks("map1.xls").Sheets("Blad1").Cells(i, j) Then
    Workbooks("map3.xls").Sheets("Blad1").Cells(i, j) = Workbooks("map1.xls").Sheets("Blad1").Cells(i, j).Value
    Else
    If Workbooks("Orgineel.xls").Sheets("Blad1").Cells(i, j) <> Workbooks("map2.xls").Sheets("Blad1").Cells(i, j) Then
    Workbooks("map3.xls").Sheets("Blad1").Cells(i, j) = Workbooks("map2.xls").Sheets("Blad1").Cells(i, j).Value
    Else
    If Workbooks("Orgineel.xls").Sheets("Blad1").Cells(i, j) = Workbooks("map1.xls").Sheets("Blad1").Cells(i, j) Then
    Workbooks("map3.xls").Sheets("Blad1").Cells(i, j) = Workbooks("Orgineel.xls").Sheets("Blad1").Cells(i, j).Value
    Else
    If Workbooks("Orgineel.xls").Sheets("Blad1").Cells(i, j) = Workbooks("map2.xls").Sheets("Blad1").Cells(i, j) Then
    Workbooks("map3.xls").Sheets("Blad1").Cells(i, j) = Workbooks("Orgineel.xls").Sheets("Blad1").Cells(i, j).Value
    End If
    End If
    End If
    End If
Next i
Next

Application.ScreenUpdating = True
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar

End Sub

Groet HWV

Met dank aan de helpers die mij met deze VBA formule`s eerder hebben geholpen.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan