Sfida di inizio Estate: estrai le iniziali

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Una sfidettina facile facile, per tutti, che si puo' onorare in tantissimi modi diversi.

Scrivi una funzione VBA che accetti una stringa di parole separate da spazi e restituisca le iniziali di ciascuna parola in maiuscolo. Ad esempio, se la stringa di input è "linguaggio di programmazione VBA", la funzione dovrebbe restituire "LPV".

Vanno ignorate le congiunzioni e le preposizioni come "di", "in", "e", ecc. (non estendiamo il divieto ai pronomi, altrimenti diventa piu' difficile compilare la tabella delle esclusioni che scrivere il codice richiesto   )

Scossa e' invitato a proporre solo dopo che qualcun altro ha rotto il ghiaccio, a meno che non sia una cosi' fantascientifica e "scossosa" che valga proprio la pena vederla subito   

[alfrimpaPartecipante alfrimpa Karma: 33 pts]

 Vecchio Frac potrebbe andare? Se l’ho fatta io vuol dire che era, come dicevano i TreTre “‘na stru**ata”   

Però probabilmente non è valida per tutte le casistiche 

Al momento non ho la possibilità di provarla 

Function Iniziali(rng as range)
Dim As Integer
Dim str As String
Dim myArr() As String
myArr = Split(rng.Value)
For i = LBound(myArr) To Ubound(myArr)
      If Len(myArr(i)) > 3 Then
           str = str & Ucase(Left(myArr(i), 1))
      End If
Next i
Iniziali = str
End Function 

[alfrimpaPartecipante alfrimpa Karma: 33 pts]

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
`

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

alfrimpa ha scritto:

potrebbe andare?

A parte quel "Dim As Integer"   

funziona perchè esclude le parole minori di tre caratteri ma non è sempre vero che sia così (con "Tanto va la gatta al lardo" restituisce "TGL": ma il verbo andare non dovrebbe essere escluso)

alfrimpa ha scritto:

Forse questa va meglio

La seconda è più aderente alla richiesta iniziale! Interessante l'uso di Match per verificare che una parola sia in un array. Nelle parole da escludere vanno aggiunti gli articoli determinativi e indeterminativi (di "Tanto va la gatta al lardo" restituisce "TVLGL")

[alfrimpaPartecipante alfrimpa Karma: 33 pts]

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)     

[scossaPartecipante scossa Karma: 37 pts]

alfrimpa ha scritto:

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 Alfredo,

ti sottovaluti! 

La tua proposta è già un ottimo punto di partenza; da una lettura del codice direi che dovresti sistemare l'intercettazione dell'apostrofo: "società anonima dell'excel" direi che restituisce SAD anziché SAE.

 

[scossaPartecipante scossa Karma: 37 pts]

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

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Ah ecco è il buon trucco dei delimitatori (quello che si usa anche per ricavare le occorrenze all'interno di una stringa).

Il problema è che VBA non brilla particolarmente in performances quando si tratta di maneggiare stringhe (se metti insieme sia InStr che le concatenazioni, inevitabilmente rallenti). Però la statistica di scossa rimane comunque interessante.

scossa ha scritto:

Ciao Alfredo,

ti sottovaluti! 

Quoto   

 

[Aldo ErcoliniPartecipante Aldo Ercolini Karma: 19 pts]

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

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Ottimo Aldo direi che funziona molto bene!   
Scossa, fai un benchmark di confronto con il codice di Aldo? Per curiosita' 

[scossaPartecipante scossa Karma: 37 pts]

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 fracSenior Moderator vecchio frac Karma: 272 pts]

scossa ha scritto:

Questo i codici per la verifica:

Anche i miei bench si basano praticamente sullo stesso codice esposto dalle API QueryPerformanceCounter e  QueryPerformanceFrequency, pero' per essere affidabile e' meglio che venga eseguito sulla stessa macchina. Voglio dire che magari otterrei risultati diversi anche se sarebbe augurabile di no, nonostante il tempo sia relativo (comunque non ho provato).

Ad ogni modo si nota che la soluzione forza bruta e' piu' efficiente del trick con Application.Match (inevitabile, dal momento che si ricorre comunque al pachiderma per valutare il confronto).

Io ho in testa un'idea alternativa ma non ho molto tempo in questi giorni. Speriamo di sistemare le cose

[scossaPartecipante scossa Karma: 37 pts]

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 fracSenior Moderator vecchio frac Karma: 272 pts]

scossa ha scritto:

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

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

E comunque a forza di centesimi lo zio Paperone e' diventato plurifantastilionario    (https://it.wikipedia.org/wiki/Fantastilione)

[scossaPartecipante scossa Karma: 37 pts]

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.

[MirkoPartecipante Mirko Karma: 2 pts]

Ciao

Una Formula 365

=CONCAT(FILTRO(MAIUSC(SINISTRA(DIVIDI.TESTO(A1;;" ")));PERRIGA(DIVIDI.TESTO(A1;;" ");LAMBDA(k;NON(O(k=DIVIDI.TESTO("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";"|")))));""))

[LucaSRPartecipante LucaSR Karma: 15 pts]

Abbiamo un altro super genio delle formule    bene   

[scossaPartecipante scossa Karma: 37 pts]

Mirko ha scritto:

Una Formula 365

non ho il 365 (Excel 2010) e non posso provare, ma credo che anche la tua formula non "intercetti" correttamente l'apostrofo:

 "Automobil Club d'Italia" penso che restituisca "ACD" e non "ACI".

[gianfranco55Partecipante gianfranco55 Karma: 91 pts]

ciao

Luca

le formule stanno avanzando  

LAMBDA

sostituisce di fatto le FUNZIONI che voi vbaisti ci propinate🤣

[LucaSRPartecipante LucaSR Karma: 15 pts]

Purtroppo per me, tra poco tempo, sarò costretto ad imparare le formule          

[scossaPartecipante scossa Karma: 37 pts]

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     

[gianfranco55Partecipante gianfranco55 Karma: 91 pts]

ciao

Scossa

come noi ci allarghiamo voi vi restringete

intanto le FUNZIONI ve le abbiamo fregate  

anche se sono limitate al 365 

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Mirko ha scritto:

Una Formula 365

Carina l'idea, nemmeno io posso provarla. Mi fido della vostra parola     

[scossaPartecipante scossa Karma: 37 pts]

gianfranco55 ha scritto:

intanto le FUNZIONI ve le abbiamo fregate

Ma ti sembra confrontabile:

=CONCAT(FILTRO(MAIUSC(SINISTRA(DIVIDI.TESTO(A1;;" ")));PERRIGA(DIVIDI.TESTO(A1;;" ");LAMBDA(k;NON(O(k=DIVIDI.TESTO("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";"|")))));""))

con 

=ACRONIMO(A1)

[gianfranco55Partecipante gianfranco55 Karma: 91 pts]

certo

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

[Autore]

Articoli