met macro zoeken in sheet en ander werkboek

[roja75]

Ik heb een stukje VBA code waarbij ik kan zoeken in een sheet. Echter nu wil ik de gevonden waarde tegelijk gebruiken om informatie te vinden in een ander werkboek.

Zie onderstaande macro.
Het is de bedoeling dat ik de gevonden waarde nummer_nr1 ook opzoek in een ander werkboek en een resultaat in hetzelfde messagebox laat zien.
Bv: Cel D2 wordt gevonden in sheet "database" en waarde in cel A2 en B2 worden weergegeven in de msgbox.
Nu wil ik waarde A2 (=nummer_nr1) op zoeken in een ander gesloten werkboek. Als deze gevonden wordt in bijvoorbeels cel A4 wil ik waarde B4 ook laten zien in de msgbox.

Nu is dus de vraag: hoe zoek ik dit in een gesloten werkboek? (Deze wil ik niet geopend hebben.)

Mijn kennis van VBA is nihil maar, ik hoop dat jullie met mijn vraag kunnen helpen.

Sub zoeken()

zoek1:
    data_nr = InputBox("Geef hier het nummer", "Van welk nummer zoek je de data file?")
    If data_nr = Cancel Then GoTo einde
    Sheets("database").Select
    On Error GoTo fout1
    Cells.Find(What:=data_nr, After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False).Activate
    data_nr1 = ActiveCell.Value
    nummer_nr1 = ActiveCell.Offset(0, -3).Value
    Datum_nr1 = ActiveCell.Offset(0, -2).Value
    gevonden = MsgBox("Data-file   " & nummer_nr1 & "   is bewerkt op   " & Datum_nr1 & Chr(13) & Chr(13) & "Wil je nog een data-file zoeken?", vbYesNo, "Resultaat")
    If gevonden = vbYes Then GoTo zoek1 Else GoTo einde
fout1:
    MsgBox ("Weet je zeker dat het nummer klopt? Het is mij niet bekend.")
einde:
    Sheets("formulier").Select
    
End Sub

 

[wampier]

JE kunt wel een ander werkboek openen, waarde opzoeken en weer sluiten (allemaal onzichtbaar voor de gebruiker) maar er is geen magische manier om via telepathische technieken een waarde op te roepen.

voorkom ook het gebruik van "select" het is onnodig en kan makkelijk tot fouten leiden.

 

[roja75]

Oke, ik ben nog even verder gaan spitten op internet.
De site http://analysistabs.com/vba/open-excel-file/ heeft mij op weg geholpen met het openen van een ander werkboek.
En met veel trial en error en geen kennis van VBA ben ik nu tot onderstaande gekomen.
En het werkt :thumb:

Ik krijg dus in 1 messagebox een resultaat voor Nummer_nr1 uit het huidige excel-bestand C:\test\database_copy4.xls, waarin de macro staat, en een resultaat van Nummer_nr1 uit een ander bestand C:\test\test.xlsx!

De code zal waarschijnlijk geen schoonheidsprijs verdienen (dus wie wil mag verbeteringen aandragen) maar ik ben tevreden

Sub zoeken()
Dim wb As Workbook

zoek1:
    data_nr = InputBox("Geef hier het nummer", "Van welk nummer zoek je de data-file?")
    If data_nr = Cancel Then GoTo einde
    Sheets("database").Select
    On Error GoTo fout1
    Cells.Find(What:=data_nr, After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False).Activate
    data_nr1 = ActiveCell.Value
    Nummer_nr1 = ActiveCell.Offset(0, -3).Value
    Datum_nr1 = ActiveCell.Offset(0, -2).Value
    
Set wb = Workbooks.Open("C:\test\test.xlsx")
    Sheets("Main").Select
    On Error GoTo fout1
    Cells.Find(What:=Nummer_nr1, After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False).Activate
    data_nr2 = ActiveCell.Value
    Nummer_nr2 = ActiveCell.Offset(0, 1).Value
    Datum_nr2 = ActiveCell.Offset(0, 2).Value
    gevonden = MsgBox("Data-file " & Nummer_nr1 & Chr(13) & Chr(13) & " is bewerkt op " & Datum_nr1 & Chr(13) & Chr(13) & "en is met dagcode " & Nummer_nr2 & " gemeten op " & Datum_nr2 & Chr(13), vbYes, "Resultaat")
    If gevonden = vbYes Then GoTo zoek_opnieuw Else GoTo einde
    
fout1:
    MsgBox ("Weet je zeker dat het nummer klopt? Het is bij mij niet bekend.")
    
zoek_opnieuw:
Set wb = Workbooks.Open("C:\test\database_copy4.xls")
    
einde:
Set wb = Workbooks.Open("C:\test\database_copy4.xls")
       
End Sub