Kirjoittaja: trinit
Kirjoitettu: 22.02.2003 – 22.02.2003
Tagit: teksti, koodi näytille, vinkki
Tämä funktio pilkkoo merkkijonon tietyllä erotinmerkillä taulukoksi ja palauttaa sen. Funktiota käytettäessä palautettavan taulukon kokoa ei tarvitse tietää etukäteen. Toiminta on rinnastettavissa PHP:n explode() funktioon pienin muutoksin tosin. Muutokset on kuvattu koodissa.
Public Function Explode(strSeparator As String, strString As String) As String() ' Funktio palauttaa merkkijonotaulukon, jonka solut täytetään niillä ' merkkijonoilla jotka löytyvät erotinmerkkien välistä. ' ' Tehnyt: 22.2.2003 - Tero Pietilä - http:/www.trinit.tk ' Päivitetty: 14.12.2003 ' ' Päivityksen syy: ' - Korjattu funktion toimintaa sellaisten erotinmerkkien osalta ' jotka ovat pidempiä kuin yksimerkkisiä ' ' Parametrit: ' ' strSeparator (String) ' ' Erotinmerkki, jonka perusteella funktio pilkkoo ' merkkijonon taulukoksi ' ' strString (String) ' ' Merkkijono, josta etsitään erotinmerkkejä ja ' josta luetaan taulukkoon asetettavat merkkijonot ' ' Poikkeukset funktion toiminnassa: ' ' - Jos strSeparator on tyhjä palautetaan yksisoluinen taulukko ' ja solu 0:an asetetaan merkkijono strString ' ' - Jos strString on tyhjä palautetaan yksisoluinen taulukko ' ja solu 0:an asetetaan tyhjä merkkijono '-------------------------------------------------------------------- Dim SeparatorCount As Integer Dim TempArray() As String ' Jos erotinmerkkiä ei ole annettu If strSeparator = "" Then ReDim TempArray(0) As String TempArray(0) = strString Explode = TempArray Exit Function End If ' Jos merkkijonoa ei ole annettu If strString = "" Then ReDim TempArray(0) As String TempArray(0) = "" Explode = TempArray Exit Function End If ' Lasketaan kuinka monta erotinmerkkiä ' merkkijonosta löytyy SeparatorCount = -1 For i = 1 To Len(strString) If Mid$(strString, i, Len(strSeparator)) = strSeparator Then SeparatorCount = SeparatorCount + 1 Next ' Jos erotinmerkkejä ei löytynyt, palautetaan strString ' merkkijono taulukon ensimmäisessä solussa (0) If SeparatorCount = -1 Then ReDim TempArray(0) As String TempArray(0) = strString Explode = TempArray Exit Function End If ' Erotinmerkkejä löytyi. Otetaan muistiin erotinmerkkien ' sijainnit merkkijonossa ReDim Positions(SeparatorCount) As Integer ' Ensimmäisen erotinmerkin sijainti Positions(0) = InStr(1, strString, strSeparator) ' Loput erotimerkit For i = 1 To SeparatorCount Positions(i) = InStr(Positions(i - 1) + 1, strString, strSeparator) Next ' Alustetaan väliaikainen taulukko joka lopuksi ' palautetaan funktion paluuarvona ReDim TempArray(SeparatorCount + 1) As String ' Ensimmäinen merkkijono TempArray(0) = Mid$(strString, 1, Positions(0) - 1) ' Loput merkkijonot SeparatorCount asti For i = 1 To SeparatorCount TempArray(i) = Mid$(strString, Positions(i - 1) + 1, Positions(i) - Positions(i - 1) - 1) Next ' Viimeinen merkkijono TempArray(SeparatorCount + 1) = Mid$(strString, Positions(SeparatorCount) + Len(strSeparator) + 1, Len(strString) - Positions(SeparatorCount)) Explode = TempArray End Function
Funkiota käytetään esim. näin:
Dim mjono As String Dim taulu() As String mjono = "Tässä on jotain tekstiä jolla voi testata explode funktion toimintaa" taulu = Explode("x", mjono) MsgBox "LBound: " & LBound(taulu) & " ja UBound: " & UBound(taulu) For i = LBound(taulu) To UBound(taulu) MsgBox i & ": " & taulu(i) Next
Funktion käyttöesimerkissä rivi: joku = Explode("x", mjono) pitäisi tietenkin olla
taulu = Explode("x", mjono)
Muokkaustoiminto koodivinkkeihin olisi mukava lisä ;)
VB:ssä on muuten Split-funktio, esim:
Dim foo As Variant
foo = Split(bar, "|")
Ja UBound(foo):lla selviää montako solua taulukossa on jne.. :)
Joo, huomasin itsekin sen vasta nyt... :)
Ja itse huomasin nyt että Laaksonen olikin jo tuon maininnut keskustelun puolella.
Nyt on korjattu käyttöesimerkin koodissa ollut kirjoitusvirhe josta mainitsin ensimmäisessä kommentissa.
Kiitoksia hyvästä vinkistä, sillä VB:n viitosversiossa ei ole Split-funktiota.
Hahaa, huomasin ettei tämä toimikaan sellaisella erotinmerkillä jossa on enemmänkuin yksi merkki. Eli esim. jos erotinmerkki on = -merkki ongelmia ei ole, mutta jos se onkin == niin funktio luulee ettei erotinmerkkejä ole ja palauttaa koko merkkijonon.
Korjaus tulossa tänne kun sen saan tehtyä ensin omaan ohjelmaani.
Funktio korjattu tänään ja nyt sen pitäisi toimia oikein.
Kokeilin tuota koodia, mutta viimeisen tiedon ensimmäinen merkki häviää. Hmmm...
Esim..
siirto.AddRows "¤", "Arvo 1¤Arvo 2¤Arvo 3¤Arvo 4¤Arvo 5¤Arvo 6" Public Function AddRows(sErotin_ As String, sArvot_ As String) As Boolean tmpTaulu = Explode(sErotin_, sArvot_) For i = LBound(tmpTaulu) To UBound(tmpTaulu) Set rw = New clsRow rw.Arvo = tmpTaulu(i) colInputRows.Add rw Next End Function
Virhe löytyi. Poistin toiseksi viimeiseltä riviltä Mid:n aloitus merkin parametrista "+1" arvon. Nyt toimii..
TempArray(SeparatorCount + 1) = Mid$(strString, Positions(SeparatorCount) + Len(strSeparator), Len(strString) - Positions(SeparatorCount))