Chi conta davvero

Ogni tanto nasce l'esigenza di contare, è più forte di noi :)

Tempo fa mi sono scritto in fretta e furia un frammento di codice che recupera le occorrenze di una stringa all'interno di un'altra stringa e non mi son mai preoccupato di testarlo seriamente. Per caso ieri ho scoperto che quella semplice routine funziona bene se deve cercare singoli caratteri all'interno di una stringa; ad esempio conta("pippo", "p") restituisce 4. Ma sbaglia piuttosto grossolanamente in fase di ricerca di gruppi di lettere perchè prima raggruppa le sottostringhe e poi restituisce il numero dei gruppi. Così ad esempio conta("1111", "11") restituisce 2 (il primo gruppo "11" viene tolto dalla stringa quindi rimane solo un altro gruppo "11"). La risposta corretta sarebbe 3 (i primi due "1", poi il secondo e il terzo "1", infine gli ultimi due "1"). Mi sono anche convinto che it's not a bug, it's a feature :)

Ecco quella versione semplificata di CountOf:

Public Function CountOf(ByVal source As String, ByVal search As String, _
                        Optional case_sensitive As Boolean = False) As Long

'source: la stringa in cui cercare
'search: la sottostringa le cui ricorrenze sono da contare
'case_sensitive (default False): la ricerca ignora maiuscole/minuscole

'conta le ricorrenze singole di una sottostringa in una stringa
'consumando i risultati se una occorrenza di search è trovata in source:
'ossia, quella sottostringa viene esclusa dalla ricerca successiva

'esempio: CountOf("aaaa1aaaa", "aa") --> 4 (i gruppi "aa" sono 6!)

Dim s As String

    s = source
    If Not case_sensitive Then s = LCase(s)
    search = LCase(search)
    CountOf = Len(Replace(s, search, search & vbNullChar)) - Len(s)
End Function

Comunque ecco qui una versione che rispetta il mandato: ritornare al mittente il giusto conteggio di tutte le occorrenze della sottostringa cercata, anche in caso di sovrapposizioni.
La routine fa anche qualcosa di più: con un opportuno parametro è n grado di restituire le posizioni delle sottostringhe cercate all'interno della stringa.

Codice:

Public Function substr(ByVal source As String, ByVal search As String, _
                   Optional ignore_case As Boolean = True, _
                   Optional return_index As Boolean = False) As Variant
                       
'conta e restituisce le ricorrenze di una sottostringa in una stringa
'source: la stringa in cui cercare
'search: la sottostringa le cui ricorrenze sono da contare
'ignore_case (facoltativo): ignora maiuscole/minuscole (default)
'return_index (facoltativo): se True restituisce una matrice con gli 
'   indici delle ricorrenze (per default restituisce solo il numero di
'   ricorrenze)
'
'es:
'substr("11001100", "11") --> Long --> 2 occorrenze
'v = substr("11001100", "11", , True) --> Array v(0)=0, v(1)=4
'substr("FranfarFaglio", "Fa", True) --> Long --> 2 occorrenze.
'substr("FranfarFaglio", "Fa", False) --> Long --> 1 occorrenze
'v = substr("FranfarFaglio", "Fa", True, True) --> Array v(0)=4, v(1)=7

Dim re As Object, matches As Object, ma As Object
Dim s As String
Dim arr() As Long
Dim idx As Long
Dim v As Variant

    Set re = CreateObject("VBScript.RegExp")
    
    'replace metacharacters with special behaviour in regex
    For Each v In Split("\,^,$,.,|,?,*,+,(,),[,{", ",")
        search = Replace(search, v, "\" & v)
    Next
    re.Pattern = "(?=(" & search & "))"
    
    re.IgnoreCase = ignore_case    'ignore case?
    re.Global = True               'matches all 
    
    If re.test(source) Then
        Set matches = re.Execute(source)
        If Not return_index Then
            substr = matches.Count
        Else
            For Each ma In matches
                ReDim Preserve arr(idx)
                arr(idx) = ma.FirstIndex
                idx = idx + 1
            Next
            substr = arr()
        End If
    Else
        substr = 0
        Set re = Nothing
        Exit Function
    End If

    Set re = Nothing
End Function