Distinct count of cells ignoring merged cells included - speed problem

Imagine scenario:

all the yellow cells have a formula.

Now I want to have the count of the cells with a formula but e.g. I4:J8 should only count for 2.

The following code shows some possibilities - some are just wrong. But the idea should be clear: Getting all cells from a range where a merged area should count only as one cell. But without touching each cell. I tried a lot of things, which are much better then the code below (analyzing the mergearea of a cell and then ignoring parts of it by row column analysis) but I would like, if someone has a good idea for that.

And imagine you have a range with a million of cells. And the formula thing is only an example, there are many situations you want to have the distinct count.

 Public Sub Example()
        Dim ar As Range
        Dim count As Long
        Dim RealCount As Long
        Dim ra As Range, ws As Worksheet
        Set ws = ActiveSheet
        Set ra = ws.UsedRange.SpecialCells(xlCellTypeFormulas)
        Debug.Print ra.Address
        For Each ar In ra.Areas
            If ar.Cells(1, 1).MergeArea.Address = ar.Address Then
                count = count + 1
            Else
                count = count + ar.Cells.count
            End If
        Next
        RealCount = GetCountRealSlowButCorrect(ra)
        Debug.Print "count by me but bad: "; count; " cells count: "; ra.Cells.count; " RealCount: "; RealCount
    End Sub
    
    Private Function GetCountRealSlowButCorrect(ra As Range) As Long
        Dim g As Range
        Dim su As Long
        su = ra.Cells.count
        For Each g In ra
            If g = g.MergeArea.Cells(1, 1) Then
                su = su - (g.MergeArea.Cells.count - 1)
            End If
        Next
        GetCountRealSlowButCorrect = su
    End Function

Solution

Here's my version - should be relatively OK performance-wise:

'set up a large range with merged cells
Sub Setup()
    Dim rng As Range
    Set rng = [A1:J20] 'contains some merged cells
    Do While rng.Row < 20000
        rng.Copy rng.Offset(rng.Rows.count)
        Set rng = rng.Offset(rng.Rows.count)
    Loop
End Sub

Sub Tester()
    
    Dim rngT As Range, rng As Range, c As Range, t, m As Range, n As Long
    
    Set rng = [A1:J19]
    Set rngT = [A1:J19]
    'creating a large range object with multiple areas and merged cells
    Do While rng.Row < 20000
        Set rngT = Application.Union(rngT, rng.Offset(20))
        Set rng = rng.Offset(20)
    Loop
    Debug.Print rngT.Areas.count & " areas", rngT.Cells.count & " cells (ignoring merges)"
    
    t = Timer
    'start counting
    For Each c In rngT.Cells
        Set m = c.mergeArea
        If m.count > 1 Then
            'only count if this is the top-left cell of the merge
            If c.Address = m(1).Address Then n = n + 1
        Else
            n = n + 1 'not merged
        End If
    Next c
    Debug.Print Round(Timer - t, 2) & " sec", n & " cells (accounting for merges)"
    
End Sub