Snellere manier om celwaarden te kopieren ?

[willema]

Beste forumleden,

In het bereik B2:B250 heb ik een formule doorgetrokken.
Bedoeling is dat na wijzigen van een cel in het bereik Q2:Q75 het bereik C2:C250 wordt gevuld met de waarden van de kolom B er naast. De waarden, niet als formule.
(kolom C is eigenlijk een temp-kolom waarin ik de waarden van de formule in kolom B op het moment van de celwijziging in Q even bewaar voor later gebruik)


Ik test dit met volgende code:

Op het werkblad:

Private Sub Worksheet_Change(ByVal Target As Range)

    Test Target

End Sub

en in een module:

Public Sub Test(ByVal Target As Excel.Range)

    Dim x As Integer
    
    [COLOR="#008000"]'alleen uitvoeren na wijziging in het bereik Q2:Q75 (kolom 17 = Q)[/COLOR]
    If Not Target.Column = 17 Then
        Exit Sub
    End If
    
    If Target.Row = 1 And Target.Row > 75 Then
        Exit Sub
    End If
    
    [COLOR="#008000"]'alleen uitvoeren bij selectie van 1 cel[/COLOR]
    If Target.Cells.Count > 1 Then
        Exit Sub
    End If
    
    [COLOR="#008000"]'niet uitvoeren bij wissen cel[/COLOR]
    If Target.Value = "" Then
        Exit Sub
    End If
    
    [COLOR="#008000"]'kopieren[/COLOR]
    For x = 2 To 250
        Cells(x, 3).Value = Cells(x, 2).Value
    Next x
    
    
End Sub

Dat werkt, maar duurt telkens 2".
Dus mijn vraag is, hoe kan ik dit sneller voor elkaar krijgen, want naar ik lees is een lus nooit de snelste manier.

Groeten,
Marnik

 

[pasan]

Probeer is

Public Sub test(ByVal Target As Excel.Range)

    With Target
     If Not .Column = 17 And Not .Row = 1 And Not .Row > 75 And Not .Cells.Count > 1 And Not IsEmpty(.Value) Then
       sn = Sheets("Blad1").Range(Cells(2, 2), Cells(250, 2))
       Sheets("Blad1").Cells(2, 3).Resize(UBound(sn)) = sn
     End If
    End With
   
End Sub

 

[willema]

Dankjewel Pasan,

ik ga dit morgen uittesten (op een pc, nu op iPad aan het surfen).
Er staat wel een Not teveel voor .Column in het If-gedeelte, maar dat corrigeer ik wel.
Ik gebruik Option Explicit, dus moet ik sn declareren. Wellicht als Range ?
En mag Sheets("Blad1"). weg ? Want als dat werkblad gedupliceerd wordt werkt de code niet meer op het duplicaat.
Of moet ik het vervangen door ActiveSheet. ?

Groeten,
Marnik

 

[willema]

Helemaal getest Pasan en het werkt zeer snel. Waarvoor dank.

sn moet ik blijkbaar declareren als Variant en niet als Range.
Sheets ("naam"). noch Activesheet. heb ik gebruikt want event wordt alleen gestart bij Worksheet_Change en vindt plaats op dat eigenste blad.

Groetjes,
Marnik

 

[snb]

Private Sub Worksheet_Change(ByVal Target As Range)
   if not intersect(target,[Q2:Q75]) is nothing then [C2:C250]=[B2:B250].value
End sub

Met application.calculation=xlcalculationmanual valt waarschijnlijk ook nog wel wat snelheidswinst te behalen.

 

[willema]

Dankjewel snb,

wie had gedacht dat het zo simpel was? Ik in elk geval niet
Het gebruik van vierkante haakjes in VBA heb ik nog niet eerder geprobeerd. Bij deze dus wel en ook met succes (maar dat was ook al zo met de code van pasan).


Groeten,
Marnik