VBA Vertikaal zoeken, sneller maken

[HWV]

Beste,

Ik gebruik de code verticaal zoeken om bestanden te zoeken in een ander bestand en dan de waarde te plaatsen in mijn bestand import.
Het werkt,......


Maar duurt erg lang.
Ik heb veel regels denk aan 40.000 die ik gebruik om klanten kaarten te maken, en hiermee de huidige voorraad er bij te zetten.
Is er een mogelijkheid om dit sneller te laten verlopen.

Sub VerticaalZoeken()

On Error Resume Next
    For j = 3 To Sheets("import").Cells(Rows.Count, 1).End(xlUp).Row
    With Workbooks("901-Artikelen ZNP incl voorraad.xls").Sheets("Data1").Columns(1).Find(Sheets("import").Cells(j, 1).Value)
        .Offset(, 5).Copy
            Sheets("Import").Cells(j, 18).PasteSpecial xlPasteValues
        .Offset(, 14).Copy
            Sheets("Import").Cells(j, 19).PasteSpecial xlPasteValues
    End With
  Next

End Sub

alvast erg bedankt voor de suggesties.

HWV

 

[alphamax]

Zet berekenen, meldingen en schermverversen tijdelijk uit

Sub VerticaalZoeken()

    On Error Resume Next

    [COLOR=#FF0000]With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With[/COLOR]
    
    For j = 3 To Sheets("import").Cells(Rows.Count, 1).End(xlUp).Row
        With Workbooks("901-Artikelen ZNP incl voorraad.xls").Sheets("Data1").Columns(1).Find(Sheets("import").Cells(j, 1).Value)
            .Offset(, 5).Copy
            Sheets("Import").Cells(j, 18).PasteSpecial xlPasteValues
            .Offset(, 14).Copy
            Sheets("Import").Cells(j, 19).PasteSpecial xlPasteValues
        End With
    Next
    
    [COLOR=#FF0000]With Application
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With[/COLOR]
    
End Sub

 

[snb]

Sub M_snb()
  sn=Sheets("import").Cells(1).currentregion.resize(,19)
  sp=Workbooks("901-Artikelen ZNP incl voorraad.xls").Sheets("Data1").cells(1).currentregion

  for j=3 to ubound(sn)
    for jj=1 to ubound(sp)
      if sn(j,1)=sp(jj,1) then exit for
    next
    if jj<=Ubound(sp) then 
      sn(j,18)=sp(jj,6)
      sn(j,19)=sp(jj,15)
    end if
  next

  Sheets("import").Cells(1).currentregion.resize(,19)=sn
End Sub

 

[HWV]

sneller

Bedankt voor de input, hij is idd nu sneller.

SNB,
Code geef nog geen waarde aan, maar geen foutmelding.Zal morgen kijken wat er mis is en dan kijken of deze sneller is als die we nu gebruiken zoals hierboven.

HWV

 

[snb]

Ik ga ervan uit dat je, zoals het hoort, in beide werkbladen cel A1 gebruikt voor het eerste gegeven in ieder werkblad.

 

[HWV]

SNB,

Even puzzelen en nu snap ik het..
Bij de Sheet Import zijn A1 en A2 leeg, als ik deze vul dan doet hij het wel.
Ik probeer te kijken om de code aan te passen maar die is nog niet zo makkelijk als gezegd

HWV

 

[snb]

Ik zou de werkbladen aanpassen (heb je ook later veel plezier van).

 

[HWV]

oke dank u, ik ga er mee aan de slag.

ik zie ook dat de nummers die uit de export in Data1 zijn opgebouwd als volgt:

="123456"

Logisch dat hij het nummer niet gevonden kreeg, helaas is de export uit ons systeem niet zonder de =" te exporteren.
Kan dit in de code verweven worden.

Import staat 123456
Data1 staat ="123456"

En dat deze dan gevonden gaat worden.

Dan hebben we ook artikelen die beginnen met letters abcd1234 en die staan in beide bestanden dus zonder de ="

Ik hoop dat de code is aan te passen, en anders moet ik eerste het bestand bewerken en de =" er uit halen.

HWV

 

[snb]

verwijder "=" met:

sheet1.cells.replace "=",""

 

[HWV]

Alleen cijfers geen letters

SNB,

Nogmaals dank, enkel loop ik tegen het volgende aan.
De zoekwaarde is niet altijd getallen:

123456
ABCD1234

Nu gaat het met de getallen goed, enkel met de letters in de zoekwaarde geef hij geen waarde weer.
Aan gezien de code nogal complex is, zou ik niet weten wat er zou moeten veranderen om dit werkend te krijgen.

HWV

 

[snb]

Sjonge,

Als je de code analyseert zie je meteeen dat dat onzin is.

Dat betekent dat de de waarden in beide bestanden verschillend zijn.
Dan zullen er wel spaties of onzichtbare tekens inzitten.

Waarom maak je het jezelf en helpers onnodig moeilijk door geen representatieve voorbeeldgegevens te plaatsen (hoe kunnen wij bijv. zien dat cel A1 niet gebruikt wordt ?)

     if trim(sn(j,1))=trim(sp(jj,1)) then exit for

 

[HWV]

Nu met bijlages

Bekijk bijlage Afnamekaart.xlsm
Bekijk bijlage 901-Artikelen ZNP incl voorraad.xls

Beste,

Sorry voor dat er geen bijlages bijzaten {zie bijlages}, ik begrijp nu dat dit zeker nodig is om een duidelijk beeld te krijgen met welke bestanden ik werk

in de bijlage de twee bestanden.
Zoals u ziet met de aanpassing is het nog niet te doen enkel de getallen.


HWV

 

[HWV]

Verschil zit in de hoofdletters in de zoek tekst

Beste SNB,

Het verschil zit hem in de hoofdletters, zodra dit gelijk is aan elkaar dan gaat het goed.
Is dit te verwerken in de code! of moet ik dan een aparte code draaien om het bestand in hoofdletters te zetten!

   Dim c As Range
   For Each c In Range("A2:A65000", Range("A2:A65000").End(xlDown))
    c = UCase(c)
   Next

HWV

 

[snb]

if trim(lcase(sn(j,1)))=trim(lcase(sp(jj,1))) then exit for

 

[HWV]

Beste SNB,

Dank voor de passende oplossing

HWV