Omzetten van een formule

[BasHD]

In een gegevens bereik laat ik excel gemiddelden maken via de functie subtotalen.

Sub SelectieAlgemeen()
'
' SelectieAlgemeen Macro
' De macro is opgenomen op 14-12-2009 door DMS.
'
    Sheets("Algemeen").Select
'
    Selection.Subtotal GroupBy:=1, Function:=xlAverage, TotalList:=Array(4, 5, _
        6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30), Replace:= _
        True, PageBreaks:=False, SummaryBelowData:=False
    ActiveSheet.Outline.ShowLevels RowLevels:=2
    Range("A1").Select
End Sub

In cel cel H3 staat nu :

=SUBTOTAAL(1;H5:H97) is de weergegeven functie in de cel.

Echter als er allemaal lege waarde staan krijg ik de foutmelding =deel/0!

Die kun je weghalen met de functie

"=IF(ISERROR(SUBTOTAL(1,F5:F97)),"""",SUBTOTAL(1,F5:F97))"

Nu is het bereik afhankelijk van de invoer.

Als je subtotalen toepast begint elke nieuwe groep met gemiddelde naamgroep in kolom A

Awaarde = Left(ActiveCell.Value, 10)

If Awaarde = "Gemiddelde" Then 

Cwaarde = ActiveCell.Offset(0, 3).Formula
[COLOR="Red"] Geeft Cwaarde= [/COLOR]"=SUBTOTAAL(1;H5:H97)"
End If

Zover kom ik. Maar dan wil ik dat er in die cel

"=IF(ISERROR(SUBTOTAL(1,F5:F97)),"""",SUBTOTAL(1,F5:F97))"

Deze formule komt.


Dus zoiets als

"=IF(ISERROR(Cwaarde),"""",Cwaarde)"

Iamand een idee of tips hoe ik dat kan doen?

Groet BB

 

[Wigi]

BB

Een voorbeeld:

Sub f()
    With ActiveCell    
        .Formula = "=IF(ISERROR(" & Replace(.Formula, "=", "") & "),""""," & Replace(.Formula, "=", "") & ")"        
    End With
End Sub

Graag ook code tags gebruiken als je code zet op het forum. Bedankt.

Wigi

 

[snb]

als in cel H3

with activecell
   .formula= replace("=IF(ISERROR(SUBTOTAL(1,#)),"""",SUBTOTAL(1,#))","#",.offset(2,-3).resize(92).address)
End with

 

[BasHD]

Geprobeerd en gelukt

hallo Wigi,

Dank voor je hulp.

Ik heb er het volgende van gemaakt en het werkt.

Sub Kleur()

Dim LastRowZ, LastRowNZ, ZoekDef1, Test1, Aantal

    Sheets("ExtraInfo").Select
     
     'hier staan de namen van alle werkbladen onderelkaar
     Aantal = Application.WorksheetFunction.CountA(Range("C2:C20"))
     Range("C1").Select
     
     For teller3 = 1 To Aantal
     
     Sheets("ExtraInfo").Select
     ActiveCell.Offset(1, 0).Select
     Test1 = ActiveCell.Value

'laatste rij in zichtbare cellen
LastRowZ = Sheets(Test1).Cells(Rows.Count, "A").End(xlUp).Row
'laatste rij incl. niet zichtbare cellen
LastRowNZ = Sheets(Test1).UsedRange.Rows.Count
'laast gevulde kolom in werkblad
LastColumn = Sheets(Test1).UsedRange.Columns.Count - 5


Sheets(Test1).Select
Range("E3").Select
        Kolom = 4
    
        For teller2 = 1 To LastColumn
        
        On Error Resume Next
        Kolom = Kolom + 1
        Cells(3, Kolom).Select
        With ActiveCell
            .Formula = "=IF(ISERROR(" & Replace(.Formula, "=", "") & "),""""," & Replace(.Formula, "=", "") & ")"
        End With
        Next teller2
        Rows(3).Interior.ColorIndex = 36
        
Sheets(Test1).Range("A1").Select
Rij = 1

For teller = 1 To LastRowZ

Rij = Rij + 1
ActiveCell.Offset(1, 0).Activate
ZoekDef1 = Left(ActiveCell.Value, 10)
    If ZoekDef1 = "Gemiddelde" Then
    
    Kolom = 4
    
    For teller2 = 1 To LastColumn
        
        On Error Resume Next
        Kolom = Kolom + 1
        Cells(Rij, Kolom).Select
        With ActiveCell
            .Formula = "=IF(ISERROR(" & Replace(.Formula, "=", "") & "),""""," & Replace(.Formula, "=", "") & ")"
        End With
        Next teller2
       
        Rows(Rij).Interior.ColorIndex = 6
        Cells(Rij, 1).Activate
        
    End If


Next teller
Next teller3


End Sub

Gr BB