Formules plaatsen met VBA

[ivoexcel]

Goededag,

onderstaande code plaats formules in cellen. Dit doet eigenlijk precies wat het moet doen alleen heb ik twee verbeter punten:
1. Ik heb liever de waarde in de cel zonder de formule.
2. het gaat om circa 5000 regels dat duurt nu dus best lang kan het sneller

Alvast bedankt!

Sub test()
Dim I As Long
Dim r1 As Range, r2 As Range, r3 As Range, r4 As Range, r5 As Range, r6 As Range, r7 As Range, r8 As Range
 
    For I = 2 To 50000
    Set r1 = Range("A" & I)
    Set r2 = Range("E" & I)
    Set r3 = Range("B" & I)
    
    Set r4 = Range("C" & I)
    Set r5 = Range("D" & I)
    Set r6 = Range("E" & I)
    Set r7 = Range("F" & I)
    Set r8 = Range("H" & I)

    If r3 >= 1 Then
        r4.Formula = "=VLOOKUP(RC[-1],Stamtabel!C[-2]:C[1],2,FALSE)"
        r5.Formula = "=VLOOKUP(RC[-2],Stamtabel!C[-3]:C,3,FALSE)"
        r6.Formula = "=VLOOKUP(RC[-3],Stamtabel!C[-4]:C[-1],4,FALSE)"
        r7.Formula = "=VALUE(LEFT(VALUE(RC[5]),5))"
        r8.Formula = "=IFERROR(VALUE(SUBSTITUTE(MID(RC[12],2,100),""."","","")),"""")"
    End If

Next I
    
   Range("C2:H2").Select
   Range(Selection, Selection.End(xlDown)).Copy
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   Columns("F:F").NumberFormat = "m/d/yyyy"
   
End Sub

 

[lam201]

Ja, met een Loop over 50.000 rijen duurt dat best lang.

probeer dit eens:

Sub formules()

Dim r as Long

'maak r laatste rijnummer
r = 25

'invoegen formules
If r >= 3 Then
    Range("C3:C" & r).Formula = "=VLOOKUP(RC[-1],Stamtabel!C[-2]:C[1],2,FALSE)"
End If

'kopieer, plakken waarde
Range("C3:H" & r).Value = Range("C3:H" & r).Value


End Sub

Alleen de formule voor kolom C.
De rest kan je zelf wel

 

[edmoor]

Je kan Range.Find of Application.Match gebruiken om de waarde op te halen, in plaats van er formules voor te gebruiken.
En Replace in plaats van de SUBSTITUTE functie.

 

[ivoexcel]

Thanks lam201!

Met de toevoeging

r = Cells(Rows.Count, "B").End(xlUp).Row

werkt het pefect!

edmoor ik zie wat ik er mee kan ga ik eens verder uitzoeken. Moet lukken maar even uitzoeken hoe het werkt. bedankt!