Zoeken tussen twee werkbladen

[luus1901]

tracht een code te schrijven die uiteindelijk twee bestanden moet vergelijken of waarden en daar vervolgens gegevens uit moet halen.
Zoals je aan de code kunt zien, ben ik nog niet lang bezig en heb ergens gelezen dat select zoveel mogelijk voorkomen moet worden.
Maar ik snap niet, hoe ik nu op een betere manier de ‘zoekwaarde kolom nummers’ kan coderen.
In het voorbeeldbestand zijn er 2 zoekwaarde, maar in werkelijkheid kan dit dus veel meer zijn.
Hoe pak je dit aan ??

Heb wel gezocht naar mogelijke oplossingen, maar kan nu helemaal niets meer vinden….

Luus

 

[spaarie]

Beste Luus,
Inderdaad kan ik zien dat je er niet lang mee bezig bent geweest, want ik er staat helemaal niks noch een code noch een bestand.
Uiteraard kunnen de helpers bij het ontbreken hiervan weinig betekenen...

 

[luus1901]

Best Spaarie,

Had het bestandje even weggehaald omdat er toch geen reactie kwam en ik nog even wilde kijken of ik er zelf uitkwam.
Maar toen moest ik plotseling weg en zag geen kans meer om het bestandje terug te zetten.
Plaats het later wel terug, misschien kan je dan even helpen???

 

[spaarie]

Tuurlijk wil ik helpen, anders had ik niet gereageerd
Hier in ieder geval een code zonder select en een stukje ingekort

Sub Spaarie()
    Application.Goto Sheets(3).Cells(1, 3)
    With Sheets(1)
        For Each v In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
            If v <> "" Then
            On Error Resume Next
            kolom = Sheets(3).Range("C1", Selection.End(xlToRight)).Find(v).Column
            v.Offset(, 1) = kolom
            End If
        Next
    End With
End Sub

Waar zal je zelf aan te denken m.b.t. je zoekblad uit het andere bestand? Want met een Find gaat dit niet lukken...

Ik denk dat de makkelijkste oplossing is om eerst een gegevens verbinding te maken met het zoekbestand en het 'vernieuwen' van de data in je code opnemen.
Dit moet dan wel gebeuren op locatie dus ik kan het niet voor je realiseren

 

[luus1901]

Toppie!! Deze gaat in het archief en zal ik zeker vaak gebruiken.
Heb echter wel wat uitleg nodig. Waarom is het nodig om in de Range notatie “A2:A” etc.
te gebruiken? Kan dit ook met cells(2,1) etc. Heb het wel geprobeerd, maar dat loopt fout

For Each v In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)

Heb nu twee bestanden gemaakt, en de code volgens jouw voorbeeld aangepast.
Is dit de juiste manier om tussen twee bestanden te zoeken, of kan het op een betere manier?
Zal uiteraard in de definitieve code Application.ScreenUpdating gebruiken.

Luus
Bekijk bijlage zoekmap.xlsx
Bekijk bijlage Zoeken met betere code_v3.xlsm

 

[spaarie]

For Each v In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)

Dit is een dynamisch bereik. Het bereik A2:A & het aantal gevulde rijen tellen van kolom A (bijv 59). Wordt het bereik A2:A59.
Zo kunnen dus meerdere zoekwaardes opgegeven worden...

Zal uitleggen hoe je een gegevensverbinding maakt.
1) Open bestand 'zoeken met betere code_v3'
2) Klik in je link op 'Gegevens'
3) Klik naast 'alles vernieuwen' op 'Verbindingen'
4) Klik op 'Toevoegen'
5) Klik op 'Blader naar meer' en zoek naar het bestand 'zoekmap' en dubbelklik hierop
6) Er opent een klein venstertje en zet het vinkje uit bij 'eerste regel zijn kolomkoppen' en klik op OK
7) Nu is er een bestandsverbinding.
8) Start de macrorecorder en klik in het lint weer op 'Gegevens'
9) Klik op 'Best. verbinden' en zoek in je lijst naar 'zoekmap' en klik op openen
10) Geef bij het bereik aan 'Blad3!A1' en klik op OK
11) Nu wordt het bestand geladen op Blad3 en zet je macro recorder uit.

Nu kun je de macro benoemen als zijnde update_zoekblad ofzo, maar let wel dat je bij deze macro 1st blad3 verwijderd en daarna een blad toevoegd eer er gegevens op geschreven worden.
Het komt er een beetje zo uit te zien

Sub update_zoekblad()
    Sheets(3).Delete
    Sheets.Add , Sheets(Sheets.Count)
        With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
        "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=C:\Documents and Settings\user\Bureaublad\zoekma" _
        , "p.xlsx;Mode=Share Deny Write;Extended Properties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Da" _
        , "tabase Password="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Glob" _
        , "al Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=Fals" _
        , "e;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Supp" _
        , "ort Complex Data=False;Jet OLEDB:Bypass UserInfo Validation=False"), Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdTable
        .CommandText = Array("Blad1$")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .SourceConnectionFile = _
        "C:\Documents and Settings\user\Mijn documenten\Mijn gegevensbronnen\zoekmap Blad1$.odc"
        .SourceDataFile = "C:\Documents and Settings\user\Bureaublad\zoekmap.xlsx"
        .ListObject.DisplayName = "Tabel_zoekmap_Blad1__1"
        .Refresh BackgroundQuery:=False
    End With
End Sub

Succes

 

[luus1901]

Dynamisch bereik snapte ik wel, maar ik wilde graag weten of je dit ook met een Cells(2, 1) etc. range kan bereiken.
Mij lukt dat nl. niet

Verbindingen zijn helemaal nieuw, dank voor de uitleg.
Helaas toch een maar, want mijn zoekbestand veranderd iedere keer van naam.
Tenzij ik het principe verbinding niet begrijp, lijkt mij deze oplossing in dit geval niet mogelijk?

Luus

 

[spaarie]

Bijna alles kan met VBA dus dat ook wel, maar is het relevant?
Bekijk deze pagina eens: http://support.microsoft.com/kb/291308

In dat geval zal gegevensverbinding geen oplossing bieden.
Dan gaan we door met je module 'SpaariePrincipe'? met de OpenFileDialog, is dit wat je wilt?

 

[luus1901]

Heb de pagina bekeken, maar toch geen antwoord gevonden. Relevant of niet, ik wil snappen waarom ik in het ene geval wel gebruik kan maken van cells(1,1) en de andere keer niet. Zie ook SpaariePrincipe, ik heb de Range "C1" veranderd in Cells(1,3).
Dit lukt me dus niet bij de dynamische range.
ter verduidelijking; mij is verteld, "gebruik zoveel mogelijk relatieve verwijzigingen, want dan kun je, indien nodig, ermee rekenen".

Doorgaan met module SpaariePrincipe graag, zodat ik kan leren wat de efficïente manier is om tussen twee bestanden te zoeken, waarvan het zoekbestand altijd een andere naam heeft.

Luus

 

[spaarie]

Die Cells moet je dan toch weer in een Range zetten bijv:

Sub a()
    With Sheets(1)
        laatste_regel = .Cells(Rows.Count, "B").End(xlUp).Row
        .Range(.Cells(1, "B"), .Cells(laatste_regel, 2)).Select
    End With
End Sub

Ik zit nu in je vb'tje, maar code loopt zeker hierop vast

kolom = Sheets(1).Range(Cells(1, 3), Selection.End(xlToRight)).Find(v).Column

Denk dat je fout hier in zit:

kolom = Sheets(1).Range([COLOR="#FF0000"]Sheets(1).[/COLOR]Cells(1, 3), Selection.End(xlToRight)).Find(v).Column

Ga ik een vb'tje maken met OpenFileDialog...

En hier is ie al...

Sub xx_zoeken_tussen_twee_bestanden()
    dlg = Application.Dialogs(xlDialogOpen).Show
    If Not dlg Then Exit Sub
    
    wbBron = ActiveWorkbook.Name
    wbDoel = ThisWorkbook.Name

    With Workbooks(wbDoel).Sheets(1)
        For Each v In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
            If v <> "" Then
            On Error Resume Next
            kolom = Workbooks(wbBron).Sheets(1).Range(Workbooks(wbBron).Sheets(1).Cells(1, 3), Selection.End(xlToRight)).Find(v).Column
            v.Offset(, 1) = kolom
            End If
        Next
    End With
    Workbooks(wbBron).Close False
End Sub

 

[luus1901]

Kwartje is gevallen! Dank voor de duidelijke uitleg.
Heb een hoop van je geleerd. :thumb:
Luus

 

[spaarie]

Top! :thumb:

Hoop dat het je wel is opgevallen dat er niet 1 lijn in zit, zodat je kan zien dat je op diverse manieren cellen en bereiken kan aanroepen..
Veel succes met je bestand!