Forse questa va meglio sempre da provare 

`Function EstraiIniziali(S As String) As String
    Dim Parole As Variant
    Dim Preposizioni As Variant
    Dim Iniziali As String
    Dim i As Integer
    Preposizioni = Array("di", "a", "da", "in", "con", "su", "per", "tra", "fra", "del", "dello", "della", "dell'", "dei", "degli", "delle", "al", "allo", "alla", "all'", "ai", "agli", "alle", "dal", "dallo", "dalla", "dall'", "dai", "dagli", "dalle", "nel", "nello", "nella", "nell'", "nei", "negli", "nelle", "col", "coi", "sul", "sullo", "sulla", "sull'", "sui", "sugli", "sulle")
    Parole = Split(S, " ")
    For i = LBound(Parole) To UBound(Parole)
        If IsError(Application.Match(LCase(Parole(i)), Preposizioni, 0)) Then
        Iniziali = Iniziali & Left(Parole(i), 1)
        End If
    Next i
    EstraiIniziali = UCase(Iniziali)
End Function
`

Per me è gia tanto quello che ho scritto non penso di poter andare oltre (di solito non partecipo ai quiz perchè non mi ritengo capace)     

Ciao,

visto che, nonostante le visite, nessun altro avanza proposte, ecco la mia alternativa, che è una variante del codice di Alfredo che, come ho detto sopra, è già una buona base di partenza.

In pratica anziché usare un array di "termini" da escludere usa una stinga:

Function Acronimo(sSUT As String) As String
  'by scossa
  Dim vParole As Variant
  Dim sEsclusi As String
  Dim sIniziali As String
  Dim i As Long
  sEsclusi = "#di#a#da#in#con#su#per#tra#fra#del#dello#della#dell#dei#degli#delle#d#" & _
      "al#allo#alla#all#ai#agli#alle#dal#dallo#dalla#dall#dai#dagli#dalle#nel#nello#nella#nell#nei#negli#nelle#" & _
      "col#coi#sul#sullo#sulla#sull#sui#sugli#sulle#il#la#lo#le#gli#l#un#una#e#ed#"
  vParole = Split(LCase(Replace(sSUT, "'", " ")), " ")
  For i = LBound(vParole) To UBound(vParole)
    If InStr(sEsclusi, "#" & vParole(i) & "#") = 0 Then
      sIniziali = sIniziali & Left(vParole(i), 1)
    End If
  Next i
  Acronimo = UCase(sIniziali)
End Function

La velocità migliora di un 84% circa, (sul mio pc); questi i risultati del test su 28.672 righe:

EstraiIniziali, finito in: 4,48068322352628
Acronimo, finito in: 0,639314276011646
---------
EstraiIniziali, finito in: 4,38083217834719
Acronimo, finito in: 0,646450392165207

Questa potrebbe essere un'alternativa

Function ACRONIMO(ByVal Periodo As String) As String
Dim Parole() As String, DaEscludere() As String, Iniziali As String, Lettere As String
Dim i As Long, y As Long
  
    Lettere = "di a da in con su per tra fra al allo alla all ai agli alle col coi del dello della dell dei degli delle d dal dallo dalla dall dai dagli dalle "
    Lettere = Lettere & "e ed nel nello nella nell nei negli nelle sul sullo sulla sull sui sugli sulle il lo la i gli le l un uno una"
                           
    DaEscludere() = Split(Lettere, " ")
                    
    Parole() = Split(LCase(Replace(Periodo, "'", " ")), " ")
    
    For i = 0 To UBound(Parole)
    
        For y = 0 To UBound(DaEscludere)
       
            If Parole(i) = DaEscludere(y) Then
                Exit For
            End If
            
        Next y
        
        If y > UBound(DaEscludere) Then
            Iniziali = Iniziali & Left(Parole(i), 1)
        End If
        
    Next i
    
    ACRONIMO = UCase(Iniziali)
    
End Function

Tempo in secondi su 28672 celle:

EstraiIniziali_alfrimpa, finito in: 4,5268582848621
ACRONIMO_ercolini, finito in: 1,54365103986129
Acronimo_scossa, finito in: 0,67628054261877
---------

EstraiIniziali_alfrimpa, finito in: 4,52999226069369
ACRONIMO_ercolini, finito in: 1,51774419050707
Acronimo_scossa, finito in: 0,67413462287368
---------

N.B.: il risultato delle function viene assegnato ad una variabile dummy, nessuna scrittura nelle celle.

Questo i codici per la verifica:

Option Explicit
  'MicroTimer function
  'Found on the net
  '

  #If VBA7 Then
  
    Private Declare PtrSafe Function getFrequency _
                Lib "kernel32" _
                Alias "QueryPerformanceFrequency" ( _
                cyFrequency As Currency) _
                As Long
    
    
    Private Declare PtrSafe Function getTickCount _
                Lib "kernel32" _
                Alias "QueryPerformanceCounter" _
                (cyTickCount As Currency) _
                As Long
  #Else
    Private Declare Function getFrequency _
                Lib "kernel32" _
                Alias "QueryPerformanceFrequency" ( _
                cyFrequency As Currency) _
                As Long
    
    
    Private Declare Function getTickCount _
                Lib "kernel32" _
                Alias "QueryPerformanceCounter" _
                (cyTickCount As Currency) _
                As Long
  #End If
  
  
  Public Function MicroTimer() As Double
      Dim cyTicks1 As Currency
      Static cyFrequency As Currency
      MicroTimer = 0
      If cyFrequency = 0 Then getFrequency cyFrequency
      getTickCount cyTicks1
      If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency
  End Function
  
Sub test()
  Dim rng As Range, rCell As Range
  Dim nStart As Double, nStop As Double
  Dim sDummy As String
  Dim j As Byte
  
  
  Set rng = Range("A1").CurrentRegion
  
  For j = 0 To 1
    nStart = MicroTimer
    For Each rCell In rng.Cells
      sDummy = EstraiIniziali(rCell.Value2)
    Next rCell
    nStop = MicroTimer - nStart
    Debug.Print "EstraiIniziali_alfrimpa, finito in: " & nStop
    
    nStart = MicroTimer
    For Each rCell In rng.Cells
      sDummy = ACRONIMO_ercolini(rCell.Value2)
    Next rCell
    nStop = MicroTimer - nStart
    Debug.Print "ACRONIMO_ercolini, finito in: " & nStop
    
    
    nStart = MicroTimer
    For Each rCell In rng.Cells
      sDummy = ACRONIMO(rCell.Value2)
    Next rCell
    nStop = MicroTimer - nStart
    Debug.Print "Acronimo_scossa, finito in: " & nStop
        
    Debug.Print "---------" & vbCrLf
  Next j
End Sub

vecchio frac ha scritto:

Voglio dire che magari otterrei risultati diversi anche se sarebbe augurabile di no, nonostante il tempo sia relativo (comunque non ho provato).

Sicuramente saranno migliori (per tutte le 3 function) rispetto a quelli rilevati sul mio pc (un asus del 2010 ..2015 nenache ricordo bene).

Comunque con microTimer si apprezzano i millesimi di secondo.

Ad esempio dichiarando la matrice vParole() as String anziché as vParole as Variant guadagno circa 5..6 centesimi :

Function ACRONIMO(sSUT As String) As String
  'by scossa
  Dim vParole() As String
  Dim sEsclusi As String
  Dim sIniziali As String
  Dim i As Long
  sEsclusi = "#di#a#da#in#con#su#per#tra#fra#del#dello#della#dell#dei#degli#delle#d#" & _
      "al#allo#alla#all#ai#agli#alle#dal#dallo#dalla#dall#dai#dagli#dalle#nel#nello#nella#nell#nei#negli#nelle#" & _
      "col#coi#sul#sullo#sulla#sull#sui#sugli#sulle#il#la#lo#le#gli#l#un#una#e#ed#"
  vParole() = Split(LCase(Replace(sSUT, "'", " ")), " ")
  For i = LBound(vParole) To UBound(vParole)
    If InStr(sEsclusi, "#" & vParole(i) & "#") = 0 Then
      sIniziali = sIniziali & Left(vParole(i), 1)
    End If
  Next i
  ACRONIMO = UCase(sIniziali)
End Function

vecchio frac ha scritto:

E' un esempio dell'importanza di dichiarare il tipo appropriato per le variabili che si usano.

Vero, però spesso, specie in caso di udf, può essere più vantaggioso dichiararle as Variant, per poter restituire un valore singolo o una matrice oppure eventuali errori.

Abbiamo un altro super genio delle formule    bene   

ciao

Luca

le formule stanno avanzando  

LAMBDA

sostituisce di fatto le FUNZIONI che voi vbaisti ci propinate🤣

gianfranco55 ha scritto:

le formule stanno avanzando  

LAMBDA

sostituisce di fatto le FUNZIONI che voi vbaisti ci propinate

Mah, MS ha solo allargato il recinto in cui vi "lascia" muovere: le "nuove" funzioni RegEx che hanno aggiunto ad Excel io me le ero fatte già nel 2010     

certo

a me piace la formula......avevi dubbi