[RESOLVED] Spliting string into pieces

[GhostRider888]

hey,
i have a string for example
abcdefghijklmnopqrstuvwxyz
is there any function or something that
will let me split this string
into several pieces?

lets say:
split(string,number of pieces)

note that i dont care if the len(string) is non dividable from the given number of pieces

for example

if the string is

abcde

and the number of pieces are 3 its ok to give a result like this:

var[1] = ab
var[2] = cd
var[3] = e

somehow with an array

hope its not that hard,
thanks in advance!

[MartinLiss]

You will need to use some combination of Left$(), Mid$() and/or Right$().

[GhostRider888]

lol i know but i m not capable of doing this, sorry!

[MartinLiss]

In order to help you I need more information. Like why not

var[1] = a
var[2] = bc
var[3] = de

And what if the number of pieces was 6 or more?

[technorobbo]

due to the nature of you request, the last variable will hold the extra letters not wholly divisible.

Try this with 1 form, 2 textboxes, 1 command button and 1 listbox for testing:

Option Explicit
Private Sub Command1_Click()
Dim str As Variant, i As Integer
List1.Clear
str = multisect(Text1.Text, Val(Text2.Text)) 'always assign to a variant
If str(0) = "" Then Exit Sub 
For i = 0 To UBound(str)
    List1.AddItem str(i)
Next
End Sub

' this is the new function
Private Function multisect(ByVal srch As String, ByVal div As Integer)
Dim tmp() As String, i As Integer, x As Integer
If div = 0 Then
    ReDim tmp(0 To 0)
    tmp(0) = ""
    GoTo sectout
End If
ReDim tmp(0 To div - 1)
x = Int(Len(srch) / div)

For i = 0 To div - 1
    tmp(i) = Mid(srch, i * x + 1, x)
Next

tmp(div - 1) = Mid(srch, (div - 1) * x + 1)

sectout:
multisect = tmp
End Function

I put in some minor error checking but you may have to expand on it depending on the app. Mathematically speaking - you example was actually diving by 2 with a remainder. The code can be mofdified for a remainder if like this:

Option Explicit
Private Sub Command1_Click()
Dim str As Variant, i As Integer
List1.Clear
str = multisect(Text1.Text, Val(Text2.Text))'always assign to a variant
If str(0) = "" Then Exit Sub 
For i = 0 To UBound(str)
    List1.AddItem str(i)
Next
End Sub


Private Function multisect(ByVal srch As String, ByVal div As Integer)
Dim tmp() As String, i As Integer, x As Integer
If div = 0 Then
    ReDim tmp(0 To 0)
    tmp(0) = ""
    GoTo sectout
End If
ReDim tmp(0 To div)
x = Int(Len(srch) / div)

For i = 0 To div - 1
    tmp(i) = Mid(srch, i * x + 1, x)
Next

tmp(div) = Mid(srch, div * x + 1)

sectout:
multisect = tmp
End Function

[GhostRider888]

due to the nature of you request, the last variable will hold the extra letters not wholly divisible.

Try this with 1 form, 2 textboxes, 1 command button and 1 listbox for testing:

Option Explicit
Private Sub Command1_Click()
Dim str As Variant, i As Integer
List1.Clear
str = multisect(Text1.Text, Val(Text2.Text)) 'always assign to a variant
If str(0) = "" Then Exit Sub 
For i = 0 To UBound(str)
    List1.AddItem str(i)
Next
End Sub

' this is the new function
Private Function multisect(ByVal srch As String, ByVal div As Integer)
Dim tmp() As String, i As Integer, x As Integer
If div = 0 Then
    ReDim tmp(0 To 0)
    tmp(0) = ""
    GoTo sectout
End If
ReDim tmp(0 To div - 1)
x = Int(Len(srch) / div)

For i = 0 To div - 1
    tmp(i) = Mid(srch, i * x + 1, x)
Next

tmp(div - 1) = Mid(srch, (div - 1) * x + 1)

sectout:
multisect = tmp
End Function

I put in some minor error checking but you may have to expand on it depending on the app. Mathematically speaking - you example was actually diving by 2 with a remainder. The code can be mofdified for a remainder if like this:

Option Explicit
Private Sub Command1_Click()
Dim str As Variant, i As Integer
List1.Clear
str = multisect(Text1.Text, Val(Text2.Text))'always assign to a variant
If str(0) = "" Then Exit Sub 
For i = 0 To UBound(str)
    List1.AddItem str(i)
Next
End Sub


Private Function multisect(ByVal srch As String, ByVal div As Integer)
Dim tmp() As String, i As Integer, x As Integer
If div = 0 Then
    ReDim tmp(0 To 0)
    tmp(0) = ""
    GoTo sectout
End If
ReDim tmp(0 To div)
x = Int(Len(srch) / div)

For i = 0 To div - 1
    tmp(i) = Mid(srch, i * x + 1, x)
Next

tmp(div) = Mid(srch, div * x + 1)

sectout:
multisect = tmp
End Function

thats perfect! mean code!!!!
its exactly what i wanted, thank u very much. (+REP)
than u too MartinLiss for ur interest.

[anhn]

Try this function if it's not too late:

Function DivStr(sText As String, Pieces As Long) As String()
    If Pieces > 0 And Pieces <= Len(sText) Then
        Dim n As Long, i As Long, p As Long, sPart() As String
        
        ReDim sPart(0 To Pieces - 1)
        n = 1 + (Len(sText) - 1) \ Pieces
        For p = 1 To Len(sText) Step n
            sPart(i) = Mid$(sText, p, n)
            i = i + 1
        Next
        DivStr = sPart
    Else
        DivStr = Split("", ",") '-- empty array
    End If
End Function

Sub XXX()
    Dim sText As String
    Dim sPart() As String
    Dim i As Long, p As Long
    
    sText = "abcdefghijklmnopqrstuvwxyz"
    p = 5
    sPart = DivStr(sText, p)
    
    For i = 0 To UBound(sPart)
        Debug.Print i; sPart(i)
    Next
End Sub

[cheowkwen]

Hi, technorobbo. I have tried your code, but it nothing happens when i clicked the command button. Based on what i understand about your code is when click on the command button, the text will be pass to the listbox right? But i can't get anything. Am i missing something?

[GhostRider888]

Try this function if it's not too late

no its not
less lines are always better, thank u very much!

cheowkwen: Check the names of ur controls (eg: list1 not list2:P) his code is working....

[technorobbo]

@cheowkwen

The code was intended to be understood by ghostrider, it works as follows.
text1 has the string to be multisected. text2 has the number of sections. Listbox will display the sections.

[GhostRider888]

oh lol he didnt write how many pieces i guess