• 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.

Verticaal zoeken op extern bestand testmacro2

Status
Niet open voor verdere reacties.
O

ozzyozzy

Gebruiker
Lid geworden
3 jul 2009
Berichten
126
graag wou ik verticaal zoeken op externe bestand. kan iemand mij hierbij helpen.

kolom A in bestand ''test macro vert. zoeken'' is zoek criteria en de achterste gegevens zou die overnemen en overschrijven vanuit bestand testmacro2. na klik op de button in bestand ''test macro vert. zoeken''.

tnxx

Code: 
Sub CommandButton1_Click()
On Error Resume Next
With Sheets("Hoofd")
    .Range("B1:B" & .Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    For Each cl In .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
        For i = 2 To Sheets.Count
            If cl.Offset(, 1) <> "" Then Exit For
            cl.Offset(, 1) = Sheets(i).Columns(1) _
                .Find(cl, , xlValues, xlWhole, xlByRows, xlNext, False).Offset(, 1).Value
        Next
        If Not BookOpen("testmacro2.xls") Then Workbooks.Open ThisWorkbook.Path & "\" & "testmacro2.xls"
        ThisWorkbook.Activate
        If cl.Offset(, 1) = "" Then
            cl.Offset(, 1) = Workbooks("testmacro2.xls").Sheets("gegevensmedewerkers").Columns(1) _
                .Find(cl, , xlValues, xlWhole, xlByRows, xlNext, False).Offset(, 1).Value
        End If
    Next
End With
Workbooks("testmacro2.xls").Close , False
End Sub

Function BookOpen(wbName As String) As Boolean
Dim wb As Workbook
On Error Resume Next
Set wb = Workbooks(wbName)
BookOpen = Not (Err.Number > 0)
End Function
 

Bijlagen

Verticalen zoeken is gelukt behalve meldling en 1ste range niet kopieren.

Hallo,

doorverwijzen is gelukt hoe ik het wou de range worden opgezocht en gevuld.

Behalve Rij A moet gelijk blijven en hoef die niet te zoeken. zie foto 35.

En ik krijg een melding ik wou het alleen via button laten verwerken. zie foto 34

Iemand een suggestie/ oplossing?

ik heb ook nog bijlage gepost hoe het werkt.

Code: 
Private Sub CommandButton1_Click()
counter = Worksheets("namen").Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To counter
    For j = 2 To 2
        Worksheets("namen").Cells(i, j).FormulaLocal = "=Vert.Zoeken(A1:A100;[alles.xlsx]Blad1!$A$2:$F$100;2;ONWAAR)"
    Next j
Next i

counter = Worksheets("namen").Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To counter
    For j = 3 To 3
        Worksheets("namen").Cells(i, j).FormulaLocal = "=Vert.Zoeken(A1:A100;[alles.xlsx]Blad1!$A$2:$F$100;3;ONWAAR)"
    Next j
Next i

counter = Worksheets("namen").Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To counter
    For j = 4 To 4
        Worksheets("namen").Cells(i, j).FormulaLocal = "=Vert.Zoeken(A1:A100;[alles.xlsx]Blad1!$A$2:$F$100;4;ONWAAR)"
    Next j
Next i

counter = Worksheets("namen").Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To counter
    For j = 5 To 5
        Worksheets("namen").Cells(i, j).FormulaLocal = "=Vert.Zoeken(A1:A100;[alles.xlsx]Blad1!$A$2:$F$100;5;ONWAAR)"
    Next j
Next i

counter = Worksheets("namen").Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To counter
    For j = 6 To 6
        Worksheets("namen").Cells(i, j).FormulaLocal = "=Vert.Zoeken(A1:A100;[alles.xlsx]Blad1!$A$2:$F$100;6;ONWAAR)"
    Next j
Next i

End Sub
 

Bijlagen

  • ScreenHunter 35.jpg
    ScreenHunter 35.jpg
    6,1 KB · Weergaven: 27
  • ScreenHunter 34.jpg
    ScreenHunter 34.jpg
    25,9 KB · Weergaven: 28
  • map1.xlsm
    map1.xlsm
    419,6 KB · Weergaven: 18
  • alles.xlsx
    alles.xlsx
    10 KB · Weergaven: 20
Niet dat ik her heel van snap maar als je VBA gebruikt dan zijn formules vaak overbodig.

Met beide bestanden in dezelfde map.

Code: 
Sub VenA()
  c00 = ThisWorkbook.Path & "\alles.xlsx"
  With GetObject(c00)
    ar = .Sheets(1).Cells(1).CurrentRegion
    .Close 0
  End With
  
  y = Application.Transpose(Application.Index(ar, 0, 1))
  ar1 = Sheets("namen").Cells(1).CurrentRegion.Resize(, 6)

  For j = 2 To UBound(ar1)
    x = Application.Match(ar1(j, 1), y, 0)
    If IsNumeric(x) Then
      For jj = 2 To 6
        ar1(j, jj) = ar(x, jj)
      Next jj
    End If
  Next j
  Sheets("namen").Cells(1).CurrentRegion.Resize(, 6) = ar1
End Sub
 
Waarom zou je transponeren.
Code: 
y =Application.Index(ar, 0, 1)
 
VenA zei:
Niet dat ik her heel van snap maar als je VBA gebruikt dan zijn formules vaak overbodig.

Met beide bestanden in dezelfde map.

Code: 
Sub VenA()
  c00 = ThisWorkbook.Path & "\alles.xlsx"
  With GetObject(c00)
    ar = .Sheets(1).Cells(1).CurrentRegion
    .Close 0
  End With
  
  y = Application.Transpose(Application.Index(ar, 0, 1))
  ar1 = Sheets("namen").Cells(1).CurrentRegion.Resize(, 6)

  For j = 2 To UBound(ar1)
    x = Application.Match(ar1(j, 1), y, 0)
    If IsNumeric(x) Then
      For jj = 2 To 6
        ar1(j, jj) = ar(x, jj)
      Next jj
    End If
  Next j
  Sheets("namen").Cells(1).CurrentRegion.Resize(, 6) = ar1
End Sub
Klik om te vergroten...

Bekijk bijlage 353671

ik krijg de volgende melding om koppelingen bij te werken. is er ook nog een optie om dit uit te schakelen. alleen via macro button koppelingen updaten.
 
Het quoten van een volledig bericht is niet nodig. De bijlage kan ik niet openen.
 
bijlage van melding

bijlage van melding
 

Bijlagen

  • ScreenHunter 36.jpg
    ScreenHunter 36.jpg
    25,7 KB · Weergaven: 31
Volgens mij heb je helemaal geen koppelingen nodig. Mogelijk kan je de melding onderdrukken door Application.DisplayAlerts = False te gebruiken.

Nb. Werkt de code? Daar schrijf je niet over.
 
code werkt prima. bedankt.

alleen werkt de volgende niet. ik krijg nog steeds de koppeling melding.

Application.DisplayAlerts = False
 
Heb jij er koppelingen in gezet?
Zo niet, druk eens op 'niet bijwerken' en sla het bestand op en heropen het opnieuw.
 
blad1 heb ik de volgende formule neergezet.
zou op nummer en naam moeten zoeken van sheet namen.

Code: 
=ALS(B4<>"";VERT.ZOEKEN(A4;namen!$A$1:$S$4000;$D$1+6);"")
 
Laatst bewerkt:
en wat is de vraag?
 
Staat de formule in het bestand waar de code ook in staat?
Formule is waarschijnlijk nog niet compleet ook (4e argument; expres weggelaten kan ook natuurlijk).
 
is in hetzelfde map map1 is opgelost. ik had verder gezocht en zag in een cell een forumle staan naar een onbekende locatie. Daar zat die telkens op te zoeken.


ik heb nog een andere vraag formule werkt wel optimaal: maar ik ben wel benieuwd of er een andere oplossing ervoor is.

Code: 
=ALS(B4<>"";VERT.ZOEKEN(A4;namen!$A$1:$S$4000;$D$1+6);"")

zal moeten zoeken vanuit sheet namen.

Een andere oplossing voor Vert.zoeken?
 

Bijlagen

Laatst bewerkt:
Lees de 2e zin in #13 nog eens en probeer te begrijpen wat er staat en hoe je het moet toepassen.
 
Namen is flexibel en artikel is vast. Vandaar een flexibiliteit in het zoeken naar namen.

Kolom B is namen.

4 argument op het einde daarom "" of waar kan ook gebruikt worden

Code: 
=ALS(B3<>"";VERT.ZOEKEN(A3;namen!$A$1:$S$4000;$D$1+6);WAAR)
 
Laatst bewerkt:
Klopt nog niet zo heel van.

Code: 
=IF(B4<>"";VLOOKUP(A4;namen!$A$1:$S$4000;$D$1+6[COLOR="#FF0000"];0[/COLOR]);"")
 
VLOOKUP veranderen in VERT.ZOEKEN
Engels → Nederlands
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan