JKP Application Development Services.

                    Microsoft Office Application Development

Array Formulas

Up • Simpele versie • Array Formulas

•  •

Search Zoeken

WWW
This site

Go to Ga Naar
Home
Up

Donate Donaties
Did you find something helpful on my site? Consider a donation!
Heeft u iets gevonden waar u wat aan had? Overweeg dan een donatie!

 

Formules voorzien van een foutcontrole

Aanpassen t.b.v. matrix formules

De eerste poging was verre van volledig. De macro is bijvoorbeeld niet berekend op cellen die matrix formules hebben.

Rekening houden met matrix formules is wat ingewikkelder dan op het eerste gezicht lijkt.

Ten eerste moet een bereik dat één matrix formule bevat ook als eenheid behandeld worden (het is niet toegestaan de formule van 1 cel binnen een matrix te veranderen). Ten tweede moet bijgehouden worden welke bereiken al bewerkt zijn, zodat hetzelfde bereik met matrixformules niet twee of meerdere keren verwerkt wordt. De onderstaande code houdt rekening met deze situaties:

 Sub ChangeFormulas()
    Dim oCell As Range
    Dim sFormula As String
    Dim sInput As String
    Dim oDone As Range
    Dim bFirst As Boolean
    Static sFormulaTemplate As String
    If sFormulaTemplate = "" Then
        sFormulaTemplate = "=IF(ISERROR(_form_),"""",_form_)"
    End If
    sInput = InputBox("Voer basis formule in", , sFormulaTemplate)
    If sInput = "" Then Exit Sub
    sFormulaTemplate = sInput
    For Each oCell In Selection
        sFormula = Replace(sFormulaTemplate, "_form_", Right(oCell.Formula, _
                   Len(oCell.Formula) - IIf(Left(oCell.Formula, 1) = "=", 1, 0)))
        If bFirst = False Then
            bFirst = True
            Set oDone = oCell
            If oCell.HasArray Then
                oCell.CurrentArray.FormulaArray = sFormula
                Set oDone = Union(oDone, oCell.CurrentArray)
            Else
                oCell.Formula = sFormula
                Set oDone = Union(oDone, oCell)
            End If
        ElseIf Intersect(oDone, oCell) Is Nothing Then
            If oCell.HasArray Then
                oCell.CurrentArray.FormulaArray = sFormula
                Set oDone = Union(oDone, oCell.CurrentArray)
            Else
                oCell.Formula = sFormula
                Set oDone = Union(oDone, oCell)
            End If
        End If
    Next
End Sub

Commentaar

Nu je het einde van dit artikel hebt bereikt, zou ik om je mening willen vragen. Wat vond je ervan?

Klik hier om mij een mailtje te sturen met je opmerkingen en suggesties.

    Subscribe in a readerpowered by longhead.com

Use the contact page to issue questions or comments about this website.
Copyright © 2003-2008 JKP Application Development Services