Excel e gli applicativi Microsoft Office Sfida numero 6: giochiamo con i vettori

Vota il vincitore della Sfida numero 6:

Sono ammesse due preferenze!

  • patel71.43%5 votes
  • Luca730%0 votes
  • scossa14.29%1 vote
  • albatros5428.57%2 votes
  • MatteoMaz14.29%1 vote
  • zer0kelvin57.14%4 votes
LoginRegistrati
Stai vedendo 16 articoli - dal 1 a 16 (di 16 totali)
  • Autore
    Articoli
  • #17558 Risposta

    vecchio frac
    Senior Moderator
    • Sfida #1
      153 pts

      In questa metà torrida estate propongo, ai superstiti e ai vacanzieri, una sfida semplice, anzi una triplice sfida.

      Giochiamo coi vettori o con gli array per creare tre piccole funzioni utili, assenti in VBA classico:

      1) creare la funzione "item_in_list(item, list)" che restituisce true se l'elemento "item" è presente in una lista di elementi passata in argomento;

      2) creare la funzione "slice(string, from, to)" , la quale affetta una stringa e restituisce una sottostringa che inizia dal carattere "from" e finisce al carattere "to", compresi;  es. slice ("pippo", 2, 4) --> "ipp";

      3) creare la funzione "string_to_array(string)" che trasforma una stringa di testo in un array di caratteri (esempio: "hello" restituisce il vettore composto da "h", "e", "l", "l", "o")

      Visto che sono funzioni piccole e semplici ma il periodo di vacanze è ancora in corso, le proposte verranno accettate fra otto giorni da adesso: quindi potrete pubblicare i vostri post da martedì 30 a partire dalle ore 12. Questa discussione viene chiusa da ora e riaperta al momento giusto.

      Eventuali richieste di chiarimento potranno essere fatte in chat o direttamente alla mail della Redazione.

      La sfida è aperta a tutti, esperti e non, registrati e non.

      Il vincitore verrà stabilito mediante sondaggio aperto a tutta la comunità: il sondaggio durerà qualche giorno (verrà stabilito al momento della chiusura della sfida). Solo le risposte che arriveranno in questa discussione verranno prese in considerazione.
      In caso di parità si terrà conto del criterio cronologico. Ognuno può pubblicare tutte le soluzioni che vuole, ma solo l'ultima postata verrà tenuta in considerazione in caso di parità di voti ottenuti.

      Il vincitore avrà la soddisfazione di aver partecipato e di aver illustrato qualche tecnica magari nuova o interessante. Inoltre avrà l'onore di proporre la sfida successiva!

      Quindi pronti? ...via! cominciate a pensarci, ci rivediamo qui a partire da martedì prossimo!

       

      #17729 Risposta

      vecchio frac
      Senior Moderator
      • Sfida #1
        153 pts

        La sfida è aperta: pubblicate! 🙂 

        Chiusura: lunedì 5 agosto ore 20

        #17730 Risposta
        patel
        patel
        Moderatore
        • Sfida #6
          31 pts

          ecco le mie soluzioni, prima le funzioni e poi l'esempio di utilizzo

          Function string_to_array(ByVal value As String)
              value = StrConv(value, vbUnicode)
              string_to_array = Split(Left(value, Len(value) - 1), vbNullChar)
          End Function
          
          Function slice(ByVal value As String, ByVal first As Integer, ByVal last As Integer)
              slice = Mid(value, first, last - first + 1)
          End Function
          
          Function IsInArray(stringToBeFound As String, arr() As String) As Boolean
            IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
          End Function
          
          Sub stringToArrayEsempio()
          Dim s As String, myArray() As String
          s = "sfida"
          myArray = string_to_array(s)
          For i = 0 To UBound(myArray)
            Debug.Print myArray(i)
          Next
          End Sub
          
          Sub slice_esempio()
          Dim s As String, s1 As String
          s = "sfidaNumero6"
          s1 = slice(s, 2, 6)
          Debug.Print s1
          End Sub
          
          Sub IsInArrayEsempio()
          Dim myArray() As String, lista As String
          lista = "mela,pera,arancia,prugna"
          myArray = Split(lista, ",")
          Debug.Print IsInArray("arancia", myArray)
          Debug.Print IsInArray("melo", myArray)
          End Sub
          
          
          
          #17732 Risposta

          vecchio frac
          Senior Moderator
          • Sfida #1
            153 pts

            La prima è identica alla mia   

            #17733 Risposta
            Luca73
            Luca73
            Partecipante
              12 pts

              Ciao a tutti

              Ecco le Mie

              Function EsisteInElenco00(Elenco As Range, TestoDaCerc As String, Optional CercaIntero As Boolean) As Variant
              Dim RangeW As Range
              Dim Vettore()
              Dim Sep As String
              Dim TestoW As String
              Sep = "|#?/$\?#|"
              If Elenco.Rows.Count = 1 Then
                  Vettore = Elenco.Cells.Value
              ElseIf Elenco.Columns.Count = 1 Then
                  Vettore = WorksheetFunction.Transpose(Elenco.Cells.Value)
              Else
                  EsisteInElenco00 = "ERRORE"
                  Exit Function
              End If
              TestoW = Join(Vettore, Sep)
              If CercaIntero Then
                  EsisteInElenco00 = TestoW Like "*" & Sep & TestoDaCerc & Sep & "*"
              Else
                  EsisteInElenco00 = TestoW Like "*" & TestoDaCerc & "*"
              End If
              End Function
              
              Function sliceLT(stringW As String, Optional fromN As Integer, Optional toN As Integer)
              If stringW = "" Then
                  sliceLT = "Errore: Stringa Vuota"
                  Exit Function
              Else
                  If fromN = 0 Then fromN = 1
                  If toN = 0 Then toN = Len(stringW)
              End If
              If fromN > Len(stringW) Then
                  sliceLT = "Errore: formN troppo grande"
                  Exit Function
              ElseIf fromN >= toN Then
                  sliceLT = "Errore: toN troppo piccolo"
                  Exit Function
              ElseIf toN > Len(stringW) Then
                  sliceLT = "Errore: toN troppo Grande"
                  Exit Function
              Else
                      sliceLT = Mid(stringW, fromN, toN - fromN)
              End If
              End Function
              
              Function VettoreParolaPerLettera(Parola)
              Dim Index As Long
              Dim VettoreW()
              If Parola = "" Then
                  VettoreParolaPerLettera = "errore parola vuota non posso creare array"
                  Exit Function
              End If
              ReDim VettoreW(1 To Len(Parola))
              For Index = 1 To Len(Parola)
                   VettoreW(Index) = Mid(Parola, Index, 1)
              Next
              VettoreParolaPerLettera = VettoreW
              End Function
              #17734 Risposta
              scossa
              scossa
              Partecipante
              • Sfida #5
                1 pt

                Ciao,
                la sfida era piuttosto semplice e le soluzioni proposte da patel mi sembrano ottime (e sono del tutto simili a quelle che stavo per proporre anch'io).
                L'unica differenza degna di nota riguarda la item_in_list (IsInArray per patel): la mia è una UDF, utilizzabile quindi anche lato cella:

                Function item_in_list(ByVal sItem As String, ParamArray lista()) As Boolean
                '
                'by scossa
                '
                    If IsObject(lista(0)) Then
                      item_in_list = UBound(Filter(Application.Transpose(lista(0)), sItem)) <> True
                    ElseIf IsArray(lista(0)) Then
                      item_in_list = UBound(Filter(lista(0), sItem)) <> True
                    Else
                      item_in_list = UBound(Filter(lista, sItem)) <> True
                    End If
                End Function

                e, come si vede dalle varie chiamate di test, è molto più "tollerante" relativamente al parametro lista passato (una stringa, un numero arbitrario di stringhe, una matrice, un range ..):

                `Sub test_funcs()
                
                      Debug.Print item_in_list("excelvba.it", "alfa", "beta", "excelvba.it", "gamma")
                      Debug.Print item_in_list("excelvba.it", Range("B2:B5")) 'gli stessi valori sopra
                      Debug.Print item_in_list("excelvba.it", "excelvba.it")
                      Debug.Print item_in_list("excelvba.it", Split("alfa, beta, excelvba.it, gamma" ","))
                      Debug.Print item_in_list("excelvba.it", "alfa, beta, excelvba.it, gamma")
                      Debug.Print item_in_list("Excelvba.it", "alfa", "beta", "excelvba.it", "gamma")
                      Debug.Print item_in_list("Excelvba.it", Split("alfa, beta, excelvba.it, gamma" ","))
                      Debug.Print item_in_list("Excelvba.it", "alfa, beta, excelvba.it, gamma")
                
                End Sub
                `
                #17735 Risposta
                albatros54
                albatros54
                Moderatore
                • Sfida #2
                  37 pts

                   

                  Per partecipare  

                  Public Function item_in_list(item As Variant, coll As Variant)
                   'che restituisce true se l'elemento "item" è presente in una lista di elementi passata in argomento;
                   Dim valore As Variant
                  For Each valore In coll
                  If valore = item Then
                  MsgBox item & "   " & "è presente nella  matrice"
                  Exit Function
                  End If
                  Next
                  MsgBox item & "   " & "non è presente nella  matrice"
                  
                  End Function
                  
                  
                  
                  Public Function slice(stringa As String, da As Long, a As Long)
                  Dim lung As Long
                  Dim dato As String
                  'la quale affetta una stringa e restituisce una sottostringa che
                  'inizia dal carattere "from" e finisce al carattere "to", compresi;
                  'es. slice ("pippo", 2, 4) --> "ipp"
                  lung = Len(stringa)
                  dato = Mid(stringa, da, a - 1)
                  MsgBox dato
                  
                  End Function
                  
                  
                  Public Function string_to_array(stringa As String)
                   'che trasforma una stringa di testo in un array di caratteri
                   '(esempio: "hello" restituisce il vettore composto da "h", "e", "l", "l", "o")
                   Dim coll As New Collection
                   Dim aumenta As Long, lung As Long, i As Long, uprow As Long
                  Dim dato As String, dat As String
                  Dim item As Variant
                   aumenta = 1
                   lung = Len(stringa)
                   For i = 1 To lung
                   dato = Mid(stringa, aumenta, 1)
                   coll.Add dato
                   aumenta = aumenta + 1
                   Next
                   uprow = 1
                   For Each item In coll
                   Cells(uprow, 6) = item
                  dat = dat & Chr(13) & Chr(10) & item
                  uprow = uprow + 1
                  Next
                  MsgBox dat
                  End Function
                  Public Function slicebis(stringa, da, a)
                   Dim coll As New Collection
                   Dim aumenta As Long, lung As Long, i As Long, uprow As Long
                  Dim dato As String, dat As String
                  Dim item As Variant
                   aumenta = 1
                   lung = Len(stringa)
                   For i = 1 To lung
                   dato = Mid(stringa, aumenta, 1)
                   coll.Add dato
                   aumenta = aumenta + 1
                   Next
                   For i = da To a
                   dat = dat & coll(i)
                   Next i
                   MsgBox dat
                  End Function
                  
                  
                  

                   

                  Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
                  Sempre il mare, uomo libero, amerai!
                  ( Charles Baudelaire )
                  #17737 Risposta

                  vecchio frac
                  Senior Moderator
                  • Sfida #1
                    153 pts

                    Quante belle idee, bravi tutti e grazie  

                    Faccio notare solo che scossa partecipa solo se adeguatamente stuzzicato: o con problemi impossibili come quello di qualche giorno fa, o con sfide che gli solleticano la fantasia     

                    #17750 Risposta
                    MatteoMaz
                    MatteoMaz
                    Partecipante
                      1 pt

                      Cercavate qualcuno che facesse da ultimo???? Eccomi  

                      Function item_in_list(ByVal item As Variant, ParamArray list()) As Boolean
                      
                      Dim Z As Variant
                      
                        item_in_list = False
                          For Each Z In list
                            If Z = item Then item_in_list = True
                              Exit Function
                            End If
                          Next Z
                      End Function
                      
                      Function slice(ByVal testo As String, PRIMO As Integer, ULTIMO As Integer) As String
                      
                      Dim l As Integer, n As Integer
                      Dim TXT As String
                      
                      TXT = ""
                      l = Len(testo)
                      
                        Select Case True
                          Case PRIMO <= ULTIMO And ULTIMO <= l
                            n = PRIMO
                              Do
                                TXT = TXT & Mid(testo, n, 1)
                                n = n + 1
                              Loop Until n > ULTIMO
                            slice = TXT
                          Case Else
                            slice = "DATI IN CONFLITTO"
                          Exit Function
                        End Select
                      End Function
                      
                      Function string_to_array(ByVal testo As String) As Variant()
                      
                      Dim v()
                      Dim k As Long
                      Dim n As Long
                      
                      n = Len(testo)
                      k = 1
                        Do
                          ReDim Preserve v(1 To k)
                            v(k) = Mid(testo, k, 1)
                              k = k + 1
                        Loop Until k > n
                      
                          string_to_array = v
                      
                      End Function
                      #17755 Risposta

                      vecchio frac
                      Senior Moderator
                      • Sfida #1
                        153 pts

                        MatteoMaz ha scritto:

                        Cercavate qualcuno che facesse da ultimo???? Eccomi

                        Grazie Matteo, in verità sono ben contento che partecipi qualcun altro oltre ai soliti noti 🙂

                        Ricordo che queste "sfide" sono apertissime a tutti e non servono solo a far vedere chi è più bravo, ma anche per scambiarsi idee o rispolverare funzioni poco usate (non uso quasi mai Filter come ha fatto per esempio patel perchè mi dimentico che c'è)

                        #17776 Risposta
                        zer0kelvin
                        zer0kelvin
                        Partecipante
                          3 pts

                          Salve a tutti.

                          Ecco le mie versioni

                          Public Function Item_In_List(Item As Variant, List As Variant) As Boolean
                              
                              Dim L As Variant
                              
                              Item_In_List = False
                              For Each L In List
                                  If L = Item Then
                                      Item_In_List = True
                                      Exit Function
                                  End If
                              Next L
                              
                          End Function
                          
                          Public Function Slice(Stringa As String, Da As Long, A As Long) As String
                              
                              Dim I As Long
                              Dim S As Variant
                              
                              S = String_To_Array(Stringa)
                              Slice = ""
                              For I = Da To A
                                  Slice = Slice & S(I)
                              Next I
                              
                          End Function
                          
                          Public Function String_To_Array(Stringa As String) As Variant
                          
                              Dim L As Long
                              Dim A As Variant
                              
                              L = Len(Stringa)
                              ReDim A(1 To L)
                              For L = 1 To L
                                  A(L) = Mid(Stringa, L, 1)
                              Next L
                              String_To_Array = A
                              
                          End Function
                          
                          #17777 Risposta

                          vecchio frac
                          Senior Moderator
                          • Sfida #1
                            153 pts

                            Grazie 0°K

                            #17780 Risposta
                            MatteoMaz
                            MatteoMaz
                            Partecipante
                              1 pt

                              Graxxxxxxiee, ti stimo fratè!

                              #17920 Risposta

                              vecchio frac
                              Senior Moderator
                              • Sfida #1
                                153 pts

                                Allora apriamo alle votazioni... cinque giorni da oggi e quindi chiusura domenica 11 alle ore 12!

                                #17923 Risposta

                                vecchio frac
                                Senior Moderator
                                • Sfida #1
                                  153 pts

                                  Intanto allego le mie proposte.

                                  Option Explicit
                                  
                                  Public Function item_in_list_VF(item, list, separator) As Boolean
                                  'utilizzo: item_in_list("pippo", "pippo,pluto,paperino", ",") --> True
                                  Dim arr As Variant, itm As Variant
                                      arr = Split(list, separator)
                                      For Each itm In arr
                                          If LCase(item) = LCase(itm) Then item_in_list_VF = True: Exit Function
                                      Next
                                      item_in_list_VF = False
                                  End Function
                                  
                                  
                                  Public Function slice_VF(ByVal s As String, ifrom As Integer, ito As Integer) As String
                                  'affetta una stringa e restituisce una sottostringa
                                  'che inizia dal carattere ifrom e finisce al carattere ito, compresi
                                  ' es. slice ("pippo", 2, 4) --> ipp
                                      If ito - ifrom + 1 <= 0 Then slice_VF = "": Exit Function
                                      slice_VF = Mid(s, ifrom, ito - ifrom + 1)
                                  End Function
                                  
                                  
                                  Function string_to_array_VF(ByVal value As String) As Variant
                                  'string_to_array("hello") --> Array("h","e","l","l","o")
                                      value = StrConv(value, vbUnicode)
                                      string_to_array_VF = Split(Left(value, Len(value) - 1), vbNullChar)
                                  End Function
                                  #18136 Risposta

                                  vecchio frac
                                  Senior Moderator
                                  • Sfida #1
                                    153 pts

                                    La sifda numero 6 è conclusa! e il vincitore è...

                                    p  a  t  e  l 

                                    Congratulazioni a patel che ha totalizzato 5 voti da sette votanti! Seguono zer0kelvin (4 voti) e albatros54 (2 voti). Grazie a tutti voi per aver partecipato! Mettiamo in cantiere la prossima sfida e se avete proposte... scrivetemi qui o sulla mail della redazione!

                                  LoginRegistrati
                                  Stai vedendo 16 articoli - dal 1 a 16 (di 16 totali)
                                  Rispondi a: Sfida numero 6: giochiamo con i vettori
                                  Gli allegati sono permessi solo ad utenti REGISTRATI
                                  Le tue informazioni:



                                  vecchio frac - 2277 risposte

                                  albatros54
                                  albatros54 - 667 risposte

                                  patel
                                  patel - 526 risposte

                                  Marius44
                                  Marius44 - 419 risposte

                                  Luca73
                                  Luca73 - 395 risposte