[excel] Waardes uit 2 excel files halen & vergelijken

[tha_crazy]

Hey mensen.
Ik heb een lastig vraagje.

Ik heb 2 excel files waarin gelijke & verschillende waardes staan.
Nu moet ik uit deze 2 excel files de UNIEKE waardes halen, dat er dus geen dubbele instaan, maar er ook geen ontbreken.

Is dit mogelijk ?
Ik zat zelf te denken aan VBA maar kan er vrij weinig over vinden wat echt behulpzaam is, en mijn kennis met VBA is ook niet zo groot.
Is er toevallig iemand die mij even een schopje in de juiste richting kan geven ?

Alvast bedankt.

Vincent

[F_J_K]

Combineer, sorteer, maak een hulpkolom waar 1 staat als gelijk aan de vorige en 0 als niet. Kopieer die kolom als waarde (!) en verwijder vervolgens alles waar een 1 staat.

Kan vast sneller en/of met minder handwerk bij even kijken naar andere functies in Excel (zoals idd VBA), maar dit werkt zonder moeilijke functies

[BtM909]

Schopje wordt lastig. Je kan dit met VBA, no doubt. Dan is het aan jou om een globale flow te maken van dingen die je moet / wilt doen.

1. Zoek de 2 excel sheets
2. Open beide sheets
3. lokaliseer velden
4. etc. etc.

Vervolgens ga je per stap bepalen hoe je dat voor elkaar krijgt binnen VBA. Bovenstaande zoekt makkelijker dan "Waardes uit 2 excel files halen & vergelijken"

Als je zo'n stappenplan eens neerzet, dan kunnen anders users je ook een gerichtere schop geven ipv in het wilde weg schoppen (is ook wat liever voor jou )

Tot slot vraag ik me af waarom je niet gewoon een derde excel sheet opent en refereert naar cellen in de externe excelsheets? Dan kan je in die mastersheet toch alsnog ontdubbelen?

[tha_crazy]

BtM909, jouw schopje heeft me veel geholpen.
Momenteel krijg ik beide xls files geopent en gekopieert in 2 verschillende sheets met de volgende code:

code:

Sub copyfirst()
    Workbooks.Open Filename:="C:\BESTEL.xls"
    Range("A1:I2834").copy
    ThisWorkbook.Activate
    Sheets("Sheet1").Activate
    
    Range("A1").Select
    ActiveSheet.Paste
    Workbooks("BESTEL.xls").Close
End Sub

Sub copysecond()
    Workbooks.Open Filename:="C:\Tools & Consumables incl. nieuwe kostensoort.xls"
    Range("A1:I2834").copy
    ThisWorkbook.Activate
    Sheets("Sheet2").Activate
    
    Range("A1").Select
    ActiveSheet.Paste
    Workbooks("Tools & Consumables incl. nieuwe kostensoort.xls").Close
End Sub

Nu moet ik echter ervoor zorgen dat de unieke waardes naar de 3e sheet gaan.
Dit wordt echter erg problematisch omdat de dubbele waardes niet op dezelvde nummers staan.
Iemand een idee ? ben zelf ook alvast aan het zoeken

[F_J_K]

Met VBA kan je eenvoudig een derde sheet aanmaken, als je sheets 1 en 2 sorteert op het te filteren veld:
hulpvariabelen i = 1, j = 1, k = 1 voor het bijhouden van de regel in sheet 1, 2, resp 3

Loop:
En dan in twee loopjes: als i al in sheet 3 staat: i=i+1. Als j al in sheet 3 staat: j=j+1.
Check of sheet1,regel i groter is dan sheet 2, regel j. Afhankelijk van de waarde i of j toevoegen (als je in sheet 3 de sortering aanhoud).

Of makkelijker: alles simpelweg in 1 sheet plakken. Sorteren. In een for loopje (begin bij i = max aantal regels):
als cel (i) = cel (i-1) dan verwijderen. Anders i = i-1.
Sorteer nogmaals om lege cellen kwijt te raken.

offtopic: je bent nogal inefficient bezig met copy/paste en activate: dat kan je ook direct aanspreken zonder het geheugen te vullen. ...Range("A1:I2834").copy destination:=Sheet2.Range("A1") of simpelweg Sheet2.Range("A1:I2834").value= Sheet1.Range("A1:I2834").value
Activate is IMHO nooit nodig en bijna nooit handig in VBA.

--

Maar bij eenmalig gebruik is de handmatige methode net zo snel (maar minder leerzaam ).

[ Voor 4% gewijzigd door F_J_K op 11-07-2008 12:20 ]

[tha_crazy]

Oplossing gevonden voor de Duplicates.
Hier zijn de macro's die ik heb gebruikt:

code:

Sub copyfirst()
    Workbooks.Open Filename:="C:\BESTEL.xls"
    Range("A1:I2834").Copy
    ThisWorkbook.Activate
    Sheets("Sheet1").Activate
    
    Range("A1").Select
    ActiveSheet.Paste
    Workbooks("BESTEL.xls").Close
End Sub

Sub copysecond()
    Workbooks.Open Filename:="C:\Tools & Consumables incl. nieuwe kostensoort.xls"
    Range("A1:J2008").Copy
    ThisWorkbook.Activate
    Sheets("Sheet1").Activate
    
    Range("A2835").Select
    ActiveSheet.Paste
    Workbooks("Tools & Consumables incl. nieuwe kostensoort.xls").Close
End Sub

Public Sub DeleteDuplicateRows()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DeleteDuplicateRows
' This will delete duplicate records, based on the Active Column. That is,
' if the same value is found more than once in the Active Column, all but
' the first (lowest row number) will be deleted.
'
' To run the macro, select the entire column you wish to scan for
' duplicates, and run this procedure.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim R As Long
Dim N As Long
Dim V As Variant
Dim Rng As Range

On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Set Rng = Application.Intersect(ActiveSheet.UsedRange, _
                    ActiveSheet.Columns(ActiveCell.Column))

Application.StatusBar = "Processing Row: " & Format(Rng.Row, "#,##0")

N = 0
For R = Rng.Rows.Count To 2 Step -1
If R Mod 500 = 0 Then
    Application.StatusBar = "Processing Row: " & Format(R, "#,##0")
End If

V = Rng.Cells(R, 1).Value
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Note that COUNTIF works oddly with a Variant that is equal to vbNullString.
' Rather than pass in the variant, you need to pass in vbNullString explicitly.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If V = vbNullString Then
    If Application.WorksheetFunction.CountIf(Rng.Columns(1), vbNullString) > 1 Then
        Rng.Rows(R).EntireRow.Delete
        N = N + 1
    End If
Else
    If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1 Then
        Rng.Rows(R).EntireRow.Delete
        N = N + 1
    End If
End If
Next R

EndMacro:

Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Duplicate Rows Deleted: " & CStr(N)

End Sub

De eerste 2 macro's zorgen ervoor dat alles in 1 sheet komt te staan.
de 3e verwijdert alle duplicates.
Werkt best fijn en snel
ruim 1900 duplicates gevonden dusja
Denk laat het hier maar even achter voor het geval iemand dezelvde vraag heeft

[F_J_K]

Thanks@update met gevonden functies. CountIf is iets langzamer bij grote datasets omdat elke cel steeds opnieuw wordt bekeken, maar als je daar geen last van hebt dan ben je er helemaal

(OTOH, VBA is langzamer dan de interne functies dus misschien is dit defacto nog wel sneller )