Formules vervangen door waarden

[harrybrinkman]

Toppers,

Ik heb een (voorbeeld)bestand waarop, op diverse werkbladen, een lijst met medewerkers. Achter deze medewerkers staan een hele massa formules. Ik ben op zoek naar een manier om in VBA op basis van de status in Kolom A, na een druk op de knop die formules te vervangen door de waarden uit die formule. Ik weet dat je kunt knippen, en weer kunt plakken als waarden maar ik krijg dat niet voor elkaar in VBA op basis van een status. Voor de duidelijkheid, die status is standaard 1 en dan moeten de formules 'gewoon' blijven staan. Als de status 2 wordt moeten de kolom F t/m AB van de desbetreffende rij vervangen worden door de waarden uit die formules. Deze wijziging van status gebeurt eenmalig. Het kan wel zij dat ik in de toekomst nog een aantal medewerkers ga toevoegen en de lijst dus naar onderen wordt uitgebreid. Het zou fijn zijn dat ik dan niet de code hoef aan te passen

Bijgevoegd een voorbeeldje van wat ik ongeveer bedoel.

Alvast bedankt voor het meedenken

mvrgr, Harry

 

[OctaFish]

Is simpel zonder VBA: zet het filter aan, filter kolom A op Status = 2, selecteer de rijen en dan kopiëren + Plakken als Waarde. Daarna zet je het filter weer op Alles.

 

[OctaFish]

Maar goed, het kan uiteraard met een macro.

Sub FormulaConvert()
Dim i As Integer, j As Integer
Dim arr As Variant, rng As Range

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    Set rng = Cells(4, 1).CurrentRegion
    For i = 0 To rng.Rows.Count - 1
        If Cells(4 + i, 1).Value = 2 Then
            For j = 0 To rng.Columns.Count - 6
                Cells(4 + i, 6 + j).Value = Cells(4 + i, 6 + j).Value
                Cells(4 + i, 6 + j).Interior.Color = vbYellow
            Next j
        End If
    Next i
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
    MsgBox "Klaar!"

End Sub

De specialisten zullen 'm anders doen, maar hier snap je vermoedelijk wat er gebeurt .

 

[edmoor]

Voor alle werkbladen ineens kan je dat zo doen:

Sub FormulesNaarWaarden()
    cm = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    For Each sh In ThisWorkbook.Sheets
        For Each cl In sh.UsedRange.Address
            If cl.HasFormula Then cl.Value = cl.Value
        Next cl
    Next sh
    Application.ScreenUpdating = True
    Application.Calculation = cm
End Sub

 

[VenA]

In een .xlsx staat geen macro en is dus ook niet te zien wat je zoal geprobeerd hebt. In het voorbeeld staan geen formules wat het er ook niet duidelijker op maakt. drie tabjes met de zelfde informatie maakt het er ook niet begrijpelijker op.

Begin gewoon in A1 en gebruik geen onnodige lege rijen.

Met een filter kan je dan eenvoudig het te doorzoeken bereik beperken.

Sub VenA()
  For Each sh In Sheets
    With sh.Cells(1).CurrentRegion
      .AutoFilter 1, 2
      For Each cl In .Columns(1).SpecialCells(12)
        cl.Resize(, .Columns.Count) = cl.Resize(, .Columns.Count).Value
      Next cl
      .AutoFilter
    End With
  Next sh
End Sub

Zonde lusje om de door de tabjes te wandelen en met jouw huidige opzet.

Sub VenA()
  For Each cl In Columns(1).SpecialCells(2, 1)
    If cl = 2 Then cl.Resize(, 28) = cl.Resize(, 28).Value
  Next cl
End Sub

of met een array

Sub VenA1()
  With Cells(4, 1).CurrentRegion
    ar = .Formula
    ar1 = .Value
    For j = 1 To UBound(ar)
      For jj = 1 To UBound(ar, 2)
        If ar1(j, 1) = 2 Then ar(j, jj) = ar1(j, jj)
      Next jj
    Next j
    .Formula = ar
  End With
End Sub

 

[snb]

Of ?

Sub M_snb()
  for each it in sheets
    it.cells.value=it.cells.value
  next
End Sub

 

[harrybrinkman]

Allen,

Het klopt dat er geen macro in mijn voorbeeldbestand zit en ook dat er geen echte formules inzitten. Ik zit met een werkgever die ontzettend ingewikkeld doet over het delen van (fragmenten uit) (excel)bestanden. Ik kan en mag onmogelijk het bestand delen. Mailen is niet mogelijk en copieren op bv. een USB staafje al helemaal niet. Ik heb daarom geprobeerd duidelijk te maken hoe dat bestand er uit ziet. Die 3 zelfde werkbladen zijn in het echt 13 stuks, wel allemaal met exact dezelfde opmaak etc.
In essentie komt het er op neer dat ik op een gegeven moment (voor alle 13 werkbladen tegelijk) de status wijzig van 1 naar 2. Op dat moment zouden in de cellen F t/m AB van de rijen waarbij de status 2 is geworden de gebruikte formules vervangen moeten worden door de waarde uit diezelfde cel. Niet de hele rij !!! alleen de kolommen F t/m AB. De kolommen B t/m E worden gevuld vanuit een personeelbestand en mogen niet mee in die "formulevervanging" Vervolgens zal de lijst uitgebreid worden naar beneden, die krijgen allemaal status 1 mee totdat ik weer besluit om ze te wijzigen naar 2.

Een en ander gebruik ik om het effect van de "oude" gegevens (status 2) buiten de nieuwe Status 1) te houden.

Dus in Jip en Janneketaal: Als de status van een rij is 2, dan vervang F t/m AB door waarden.

Duidelijker kan ik het zonder voorbeelden niet maken helaas, Ik begrijp dat niet niet meest heldere vraagstelling is, maar ik kan/mag even niet anders

Mvrgr,
Harry

 

[snb]

Een oneliner volstaat:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  If Target.Column = 1 And Target = 2 Then Target.Offset(, 5).Resize(, 23).Value = Target.Offset(, 5).Resize(, 23).Value
End Sub

Weer typisch een voorbeeld van een onjuist gestructureerde gegevensverzameling (database), want verspreid over 13 werkbladen.
In plaats van gegevens in een overbodige kolom ( A ) zou ik dubbelklik gebruiken:

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 1 Then
         Target.Offset(, 5).Resize(, 23).Value = Target.Offset(, 5).Resize(, 23).Value
         Cancel = False
    End If
End Sub

 

[VenA]

Het klopt dat er geen macro in mijn voorbeeldbestand zit en ook dat er geen echte formules inzitten. Ik zit met een werkgever die ontzettend ingewikkeld doet over het delen van (fragmenten uit) (excel)bestanden.

Elk bestand is na te bouwen zonder enige gevoelige informatie. Waarom huurt de werkgever niet even iemand in? Hoef jij niet te 'prutsen' en is iedereen waarschijnlijk blij. Of je alle code's getest en eventueel aangepast hebt betwijfel ik.

 

[LucHeyndrickx]

En als ik zo hoor dat het de werkgever is die zulke eisen stelt... waarom niet gewoon een PDF van je werkblad opsturen?