› Excel e gli applicativi Microsoft Office › Sfida numero 6: giochiamo con i vettori
-
AutoreArticoli
-
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!
La sfida è aperta: pubblicate! 🙂
Chiusura: lunedì 5 agosto ore 20
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
La prima è identica alla mia
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
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 `
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 )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
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
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'è)
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
Grazie 0°K
Allora apriamo alle votazioni... cinque giorni da oggi e quindi chiusura domenica 11 alle ore 12!
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
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!
-
AutoreArticoli