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

zoeken aantal pal in verschllende files

Status
Niet open voor verdere reacties.
O

oneilboy

Gebruiker
Lid geworden
7 jun 2019
Berichten
34
Hoi

we hebben dus een file genoemd test 1 en in kolom B staan een tal ref die hij dan moet terugzoeken en verschillende excel files (book 1 en book 2).

als er bv in de file test 1 de ref 325 staat moet hij in de file book 1 de ref 325 zoeken en dan dan naar boven zoeken tot hij in kolom N het aantal pal vindt en dat getal in kolom E van de file test 1 invullen. dus voor die 325 moet hij dan 65 vinden onder tabblad woensdag van file book 1 en dat invullen in kolom N van de file test 1.

Wie kan me helpen met een macro voor deze opdracht?

alvast bedankt
 

Bijlagen

  • Book1.xlsx
    12,2 KB · Weergaven: 17
  • Book2.xlsx
    29 KB · Weergaven: 16
  • test 1.xls
    31,5 KB · Weergaven: 20
Heb een voorbeeldbestand gemaakt. De layout heb ik veranderd waardoor je verticaal kunt zoeken.
(Referenties onder elkaar en de dagen op 1 tablad).
 

Bijlagen

  • test 1.xlsx
    11,6 KB · Weergaven: 15
  • Book1.xlsx
    14,5 KB · Weergaven: 19
Hoi,

maar de macro zou het moeten opzoeken zonder dat ik de files moet aanpassen
 
Waarom is het hoofdbestand een .xlx? Dit kan problemen geven met het zoeken in een .xlsx.

Met de drie bestanden in dezelfde map

Code: 
Dim b As Boolean

Sub VenA()
  Application.ScreenUpdating = False
  Set wb1 = GetObject(ThisWorkbook.Path & "\Book1.xlsx")
  Set wb2 = GetObject(ThisWorkbook.Path & "\Book2.xlsx")
  ar = Sheets("Sheet1").Cells(1).CurrentRegion
  For j = 2 To UBound(ar)
    b = False
    ar(j, 5) = Zoek(wb1, CStr(ar(j, 2)))
    If Not b Then ar(j, 5) = Zoek(wb2, CStr(ar(j, 2)))
  Next j
  wb1.Close 0
  wb2.Close 0
  Sheets("Sheet1").Cells(1).CurrentRegion = ar
End Sub

Function Zoek(wb, s) As Double
  For Each sh In wb.Sheets
    t = Application.Match(s, sh.Columns(3), 0)
    If IsNumeric(t) Then
      b = True
      For c = t To 2 Step -1
        If sh.Cells(c, 14) <> "" Then
          Zoek = sh.Cells(c, 14)
          Exit Function
        End If
      Next c
    End If
  Next sh
End Function
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan