Sfida numero 6: giochiamo con i vettori

[vecchio fracSenior Moderator vecchio frac Karma: 245 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!

 

[vecchio fracSenior Moderator vecchio frac Karma: 245 pts]

La sfida è aperta: pubblicate! 🙂 

Chiusura: lunedì 5 agosto ore 20

[patelModeratore patel Karma: 50 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

[vecchio fracSenior Moderator vecchio frac Karma: 245 pts]

La prima è identica alla mia   

[Luca73Partecipante Luca73 Karma: 56 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

[scossaPartecipante scossa Karma: 25 pts]

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
`

[albatros54Moderatore albatros54 Karma: 83 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 )

[vecchio fracSenior Moderator vecchio frac Karma: 245 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     

[MatteoMazPartecipante MatteoMaz Karma: 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

[vecchio fracSenior Moderator vecchio frac Karma: 245 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'è)

[zer0kelvinPartecipante zer0kelvin Karma: 5 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

[vecchio fracSenior Moderator vecchio frac Karma: 245 pts]

Grazie 0°K

[MatteoMazPartecipante MatteoMaz Karma: 1 pt]

Graxxxxxxiee, ti stimo fratè!

[vecchio fracSenior Moderator vecchio frac Karma: 245 pts]

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

[vecchio fracSenior Moderator vecchio frac Karma: 245 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

[vecchio fracSenior Moderator vecchio frac Karma: 245 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!

[Autore]

Articoli