functie omzetten naar VBA

[perry99]

Hallo,

Gisteren heeft iemand mij geholpen met onderstaande functie.
Kan iemand mij helpen hoe deze om te zetten naar een VBA.
De bedoeling is eigenlijk dat het bestand zo klein mogelijk blijft.
Als ik onderstaande functie op een regel zet, pakt dat meteen 4mb daar de functie moet zoeken in 3 databestanden van
elk 15000 regels.
Hoop dat door middel van een VBA het bestand een stuk kleiner wordt dan 4mb.
Heb 2 bestanden bijgevoegd 1 werkbestand en 1 databestand.
De functie staat hieronder.

 =ALS(ISFOUT(ALS(ISFOUT(VERT.ZOEKEN(D2;[artikelbestand1.xls]Code1!$B$1:$C$15000;2;));
VERT.ZOEKEN(D2;[artikelbestand1.xls]Code2!$B$1:$C$15000;2;ONWAAR);
VERT.ZOEKEN(D2;[artikelbestand1.xls]Code1!$B$1:$C$15000;2;)));
VERT.ZOEKEN(D2;[artikelbestand1.xls]Code3!$B$1:$C$15000;2;ONWAAR);
ALS(ISFOUT(VERT.ZOEKEN(D2;[artikelbestand1.xls]Code1!$B$1:$C$15000;2;));
VERT.ZOEKEN(D2;[artikelbestand1.xls]Code2!$B$1:$C$15000;2;ONWAAR);
VERT.ZOEKEN(D2;[artikelbestand1.xls]Code1!$B$1:$C$15000;2;)))

Ik hoop dat iemand mij kan helpen.
Alvast bedankt voor jullie medewerking

Groetjes,

Perry

 

[Warme bakkertje]

Zet alle artikels op 1 werkblad en plaats deze code in de Bladmodule van Blad1 van Sol Projecten

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 4 Then
With Workbooks("artikelbestand1.xls").Sheets("Code1")
   Set c = .Columns(2).Find("**" & Target.Value, , xlValues, xlWhole)
End With
Target.Offset(, 2).Value = c.Offset(, 1).Value
End If
End Sub

 

[perry99]

Hallo Rudi,

Erg bedankt voor de code.

Het werkt, echter het zoeken van een artikelnr na 8000 regels duurt lang.
Om je een voorbeeld te geven als een artikelnr op regel 28000 staat, duurt het ongeveer 14 seconden voordat de
omschrijving er staat.
Kan je ook nog naar een andere oplossing kijken.
Ik hoop dat je mij kan helpen.
Nogmaals mijn dank voor het meedenken.

Groetjes,
Perry :thumb::thumb::thumb::thumb:

 

[Warme bakkertje]

zet deze eens bovenaan je code

Application.Calculation = xlCalculationManual

en deze onderaan

Application.Calculation = xlCalculationAutomatic

want bij mij duurde een zoekaktie naar regel 60000 < 0.5 sec.

 

[perry99]

Goedemorgen Rudi,

Ongeloofelijk dat er mensen zijn die in de nacht bezig zijn om andere mensen te helpen op dit forum.
Een hele dikke pluim hiervoor. :thumb::thumb::thumb::thumb::thumb:

Onderstaande code heeft niet geholpen, het blijft een tijdje duren voordat de omschrijving erbij staat.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.Calculation = xlCalculationManual
If Target.Column = 4 Then
With Workbooks("artikelbestand1.xls").Sheets("Code1")
   Set c = .Columns(2).Find("**" & Target.Value, , xlValues, xlWhole)
End With
Target.Offset(, 2).Value = c.Offset(, 1).Value
End If
Application.Calculation = xlCalculationAutomatic
End Sub

Kan je kijken of er nog een andere oplossing is.

Alvast bedankt voor je bijzondere medewerking.

Groetjes,

Perry:thumb::thumb::thumb:

 

[Warme bakkertje]

Heb je een query lopen in je artikelbestand ?
Kopieer al je gegevens eens naar een nieuw bestand en plak ze als waarden. Pas de bladnaam en bestandsnaam aan anders krijg je foutmelding bij gebruik v/d macro. Probeer dan de zoekfunctie eens uit op dit nieuwe bestand.

 

[perry99]

Hallo Rudi,

Had inderdaad een query lopen.
Het loopt nu als een speer.

Hartstikke bedankt voor jouw hulp in deze.

De vragenstellers mogen blij zijn met mensen als jij hierop het forum.

Nogmaals mijn dank voor je hulp.

Groetjes,

Perry:thumb::thumb::thumb::thumb::thumb: