formule omzetten naar VBA

[adile]

goedemorgen,

Kan iemand mij helpen met de volgende formule om te zetten naar een VBA code?

=ALS(C6="VL";HORIZ.ZOEKEN($B6;$BQ$40:$BW$41;2;0);ALS.FOUT(VERT.ZOEKEN(C6;$BO$1:$BP$73;2;0);""))

Deze formule staat in de cellen C6 t/m C102, D6 t/m D102, F6 t/m F102, H6 t/m H102.

Alvast bedankt

Gr Adile

 

[OctaFish]

Huh? Je heb een formule in C6 staan, en je wilt dezelfde formule met VBA erin zetten? Wat is daar het nut van? Bovendien: hoe kan je een formule in een cel zetten die zijn eigen waarde (VL) moet evalueren? Dat is toch een kringverwijzing?

 

[OctaFish]

Overigens: als je de macro opneemt, krijg je een code die je makkelijk verder kunt verwerken. Ik heb 'm dus níet in C6 opgenomen vanwege die kringverwijzing maar in D6:

Sub Macro1()
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""VL"",HLOOKUP(RC2,R40C69:R41C75,2,0),IFERROR(VLOOKUP(RC[-1],R1C67:R73C68,2,0),""""))"
End Sub

 

[adile]

Octafish,

je hebt helemaal gelijk, ik was even in de war maar in kolom C6 t/m C102 staat de data die moet vergeleken worden met de data in kolommen BO en BP.
dus het moet zijn Kolom D, F, H, I, J enz. ik voeg even een voorbeeld toe van wat ik precies bedoel, want ik wil jouw code ombouwen maar ik snap hem niet helemaal.
In het voorbeeld heb ik de formule in kolom D laten staan, en bij de rest van de kolommen verwijderd anders was het bestand te groot.


Adile

 

[adile]

Goedenavond,

Is er iemand die mij met bovenstaande probleem kan helpen,
ik heb ik het mijn bestand normaal gesproken 13 sheets waar onderstaande formule per sheet meer dan 2800 keer op staat.
het bestand is daardoor erg groot en wat trager.
daarom wil ik vragen of iemand deze formule middels een VBA code per sheet kan vereenvoudigen waardoor het bestand een heel stuk kleiner wordt qua MB's.

=ALS(C6="VL";HORIZ.ZOEKEN($B6;$BQ$40:$BW$41;2;0);ALS.FOUT(VERT.ZOEKEN(C6;$BO$1:$BP$73;2;0);""))

een voorbeeld van het bestand staat bij mijn reactie van 15 januari 00:37.

Adile

 

[adile]

O.

 

[Cobbe]

Er zat een foutje in vorige code.

Plak deze functie in een module en roep ze aan via fct(b6) en zo verder naar beneden slepen.
Wel eerst die validaties in kolom D weghalen.

Public Function fct(cl As Range)
 On Error GoTo nietgevonden
 Dim cc As Variant
 With Worksheets("Per3")
  If cl.Offset(0, 1) = "VL" Then
  Set c = .Range("BQ40:BW40").Find(cl.Value, LookIn:=xlValues)
   If Not c Is Nothing Then
    fct = Range(c.Address).Offset(1).Value
     Exit Function
   End If
nietgevonden:
  Set cc = .Range("BO7:BO64").Find(cl.Offset(0, 1).Value, LookIn:=xlValues, Lookat:=xlWhole)
   If Not cc Is Nothing Then
    fct = Range(cc.Address).Offset(0, 1).Value
   End If
 End If
End With
End Function

 

[Ginger]

Vervang nooit de ingebouwde functies voor UDF's. Een UDF haalt niet dezelfde snelheid. In jouw geval zou het dan een knop moeten worden die via VBA vaste waarden op je sheet plaatst. Maar of dat nou echt makkelijker is???

 

[snb]

@Ginger

Zeker wel:

Sub M_snb()
   sn = Sheet3.Range("A5:BF102")
   For j = 1 To UBound(sn)
     For jj = 4 To UBound(sn, 2) step 2
        If sn(j, jj - 1) <> "" Then
           If sn(j, jj) = "VL" Then
             sn(j, jj) = sn(j, 2) / 20
           Else
               Select Case sn(j, jj - 1)
               Case "O-G"
                 sn(j, jj) = 8.5
               Case "Exp"
                 sn(j, jj) = 9.5
               Case "M-G"
                 sn(j, jj) = 6
               Case "M-P M", "M-P A", "HSE"
                 sn(j, jj) = 4
                Case "OR"
                  sn(j, jj) = 3
                Case "Gpl Sell"
                   sn(j, jj) = -5
                Case "VL", "Vervang", "Ruiling", "BBM", "N-B", "reserve", "VIR", "Overleg"
                Case "Verk"
                 sn(j, jj) = 10
                Case "Recp9", "Rec L"
                 sn(j, jj) = 9
                Case Else
                  sn(j, jj) = 8
                End Select
           End If
       end if
     Next
   Next
   
   Sheet3.Range("A5:BF102") = sn
End Sub

NB. In de opzet van Adile zit sowieso een denkfout: er hoeft helemaal geen hlookup te worden gebruikt omdat de waarde in kolom B gewoon gedeeld moet worden door 20.

 

[adile]

dank jullie wel voor het meedenken

@cobbe,


Ik heb jouw manier gebruikt, maar ik krijg #WAARDE! als waarde in de cel. misschien dat ik iets verkeerd doe? Waarom moet ik fct(B6) gebruiken? ik gebruik toch cel C6?

@snb

jouw manier werkt ook, dat vindt ik denk ik een beter idee ik hoef nu geen formules in de cellen te zetten waardoor het bestand een stuk kleiner wordt.


ik wacht nog even op uitleg van cobbe daarna zal ik hem op opgelost zetten. hartelijk dank.
Adile

 

[sylvester-ponte]

adile, als je het met een sub doet bvb zoals die van snb dan moet je wel steeds die sub laten draaien als er iets veranderd.

als je een function gebruikt zo als die van cobbe dan gaat dat herberekenen van zelf.

en je kan de je eigen formule en die van cobbe en snb versnellen door de lijstjes te laten beginnen met een lege cel .
ik bedoel dat je eerst test of de waarde waarmee je vergelijkt gelijk is aan ""
dit omdat er vele cellen in je bestand leeg zijn.

 

[adile]

Sylvester Ponten,

Ik weet niet hoe je dat doet met die lege cellen.
maar wanneer ik snb zijn oplossing gebruik hoef ik hem maar 1x te laten berekenen zeg maar en dat handmatig, dat is in principe niet zo''n probleem.
traag is ie dan niet.

adile

 

[sylvester-ponte]

adile, als het snel genoeg werkt dan heeft optimaliseren op snelheid geen zin.
en als later toch de snelheid een probleem wordt dan horen we het wel.

als handmatig geen probleem is . dan hoeft de oplossing van snb niet in een function gegoten te worden.
anders is het geen probleem om de sub in een function om te zetten.