Formules omzetten naar waarde mbv VBA

[adile]

Goedenavond,

Ik heb een bestandje waarin ik in cel U12 (dit is een samengevoegde cel van cellen U12:AB12) de onderstaande formule heb staan.

=ALS(H12="";"";ALS.FOUT(INDEX(Data!$AV$4:$AV$116;VERGELIJKEN("ERTL1";VERSCHUIVING(Data!$AV$4:$AV$116;;VERGELIJKEN(Data!$AV$1;Data!$AW$2:$OV$2;0));0));""))

Wanneer ik in H12 iets invul dan komt de uitkomst in U12 te staan.
nu wil ik dat dit eenmalig gebeurt, dus wanneer de formule zijn werk gedaan heeft dan moet de formule veranderen in een waarde dmv VBA.

nou ik heb de 2 onderstaande codes gevonden, wanneer ik deze invul dan krijg ik een error en crasht mijn bestand, en start het opnieuw op.
weet iemand wat de oorzaak hiervan is en is er een oplossing voor?

deze code moet ook gelden voor cellen U13 t/m U21

Private Sub Worksheet_Change(ByVal Target As Range)

Range("U12:AB12").Value = Range("U12:AB12").Value

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
With Range("U12:AB12")
    .Copy
    .PasteSpecial xlValues
End With
End Sub

Adile

 

[MarcelBeug]

De codes werken bij mij gewoon (weliswaar met een andere formule, maar dat mag niet uitmaken). Het zijn wél codes die bij het werkblad horen, dus niet in een aparte module.
Ze worden afgevuurd bij elke wijziging in het werkblad. Dus ook de wijziging uit hoofde van de procedure, oftewel je kunt in een eeuwige loop terecht komen.
Eigenlijk vreemd dat ze bij mij wél werken...

Je moet er wél voor zorgen dat je eerst die formule hebt ingevoerd, dan de macro invoeren en als eerste H12 aanpassen, anders is je formule al een waarde geworden voordat je in H12 iets ingevuld hebt.

Als je de macro alleen effectief wilt laten werken als er iets in H12 verandert, en wilt voorkomen dat je in een eeuwige loop terecht komt, dan kun je er dit van maken:

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, Range("H12")) Is Nothing Then Exit Sub
    
    Application.EnableEvents = False
    
    Range("U12:AB12").Value = Range("U12:AB12").Value

    Application.EnableEvents = True
    
End Sub

Die macro zal dan welgeteld 1 keer echt zijn werk doen en daarna nog steeds bij elke wijziging in het werkblad worden afgevuurd.

Kortom: waarom niet gewoon handmatig even kopiëren en plakken met waarden?

 

[Cobbe]

Deze doet maar één keer zijn werk en gaat dan in winterslaap:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("H12")) Is Nothing Then
     Application.EnableEvents = False
       Range("U12").Value = Range("U12").Value
     Application.EnableEvents = True
   With ThisWorkbook.VBProject.VBComponents("Blad1").CodeModule
    .DeleteLines .ProcStartLine("Worksheet_Change", 0), .ProcCountlines("Worksheet_Change", 0)
   End With
  End If
End Sub

PS: Wel je bladnaam eventueel aanpassen.

 

[adile]

Heren,

Bedankt voor de input. De oplossing van Cobbe is precies wat ik nodig heb.
alleen werkt hij nu alleen voor de cellen H12 en U12. Wanneer ik de range uitbreidt naar ("H12:H21") en ("U12:U21"),
zoals in de code hieronder, werkt hij niet meer.
Wanneer ik iets invul in bv H12 of bv H18 dan haalt hij de formules weg voor U12:U21, maar dit moet per rij gebeuren.
dus wanneer ik iets invul in H15 moet alleen de formule van U15 verdwijnen enz.
is dat mogelijk?

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("H12:H21")) Is Nothing Then
     Application.EnableEvents = False
       Range("U12").Value = Range("U12:U21").Value
     Application.EnableEvents = True
   With ThisWorkbook.VBProject.VBComponents("Blad1").CodeModule
    .DeleteLines .ProcStartLine("Worksheet_Change", 0), .ProcCountlines("Worksheet_Change", 0)
   End With
  End If
End Sub

Adile

 

[Cobbe]

En is het goed genoeg als die code verdwijnt bij het verlaten van dat werkblad?

 

[adile]

Ja dat zou ook kunnen, alleen dan zou hij ook moeten verdwijnen als ik het bestand afsluit. Want mocht ik het werkblad niet verlaten maar het bestand wel afsluiten dan moeten die formules ook weg zijn wanneer ik het bestand de volgende keer opstart.

 

[Cobbe]

Kun je dat bestand(met fictieve waardes) niet posten, want ik las dat je samengevoegde cellen gebruikt.
Dan gaat het zeker weer mis lopen.

 

[adile]

Cobbe,

Dit is een extreem uitgeklede versie, anders was hij te groot.
maar het zou dus moeten werken wanneer je dubbel klikt op H12 t/m H21,Bekijk bijlage Voorbeeld.xlsm
dan komt er een naam te staan in U12 t/m U21 (degenen waar een formule in staat.

Omdat die formule op basis van datum is dan veranderd de naam de volgende keer wanneer je het bestand opent,
maar dit moet dus de eerste naam blijven die erin komt te staan.

Adile

 

[HSV]

Adile,

Verwijder al je samengevoegde cellen.
Daar kan je geen touw aan vast knopen en zorgen alleen maar voor problemen in Vba code.

 

[HSV]

Verwijder de formules in de cellen U12:U21.
Als je toch al met Vba bezig bent waarom dan de rest ook niet afhandelen met Vba.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Union(Range("H12:Q21"), Range("AX2:AX4"))) Is Nothing Then
 Target.Value = Time
 Cancel = True
 If Target.Column = 8 Then Target.Offset(, 13) = Sheets("data").Cells(Application.Match(Application.WeekNum(Date, 2), Sheets("data").Columns(1), 0), 8).Value
End If
End Sub

 

[adile]

HSV,

Het bestandje dat ik er hier op heb gezet maakt deel uit van een veel groter bestand,
waarin heel veel macro's zijn opgenomen. Wanneer ik de samenvoegingen eruit haal, heb ik een veel groter probleem.

Ik heb je code van #10 proberen te gebruiken, maar deze werkt niet. Het blijft leeg.
let wel de formules in kolom U zijn verschillend.

Adile

 

[HSV]

Dan heb je jezelf mooi in de nesten gewerkt en zie ik voor jou geen oplossing meer.
De code werkt terdege als je de samengevoegde cellen verwijderd.

Wat misschien nog zou kunnen werken is:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Union(Range("H12:Q21"), Range("AX2:AX4"))) Is Nothing Then
 Target.Value = Time
   If Target.Column = 8 Then Target.Offset(, 12) = Target.Offset(, 12).Value
End If
Cancel = True
End Sub

Maar daarmee houd ik voor gezien.

 

[adile]

HSV,

De laatste code van jou werkt perfect. :thumb:
Die ga ik ook gebruiken, dank voor je hulp.
Cobbe, jij ook bedankt voor de input.

Ik ga hem als opgelost markeren.

Adile