BreadCrumbs: Excel

Excel

From Luke Jackson

(Difference between revisions)
Jump to: navigation, search

Revision as of 11:32, 3 May 2008

Sub SplitDemo()
    Dim txt As String, ftxt As String, x As Variant, i As Long
    txt = ActiveCell.Value
    x = Split(txt, "/")
    For i = 0 To UBound(x)
       MsgBox x(i)
    Next i
    ftxt = x(1) & "/" & x(0) & "/" & x(2)
    MsgBox ftxt
End Sub

Public Function Split(ByVal sInput As String, _
Optional ByVal sDelimiter As String, _
Optional ByVal nLimit As Long = -1, _
Optional ByVal bCompare As Integer = vbBinaryCompare _
) As Variant
  
Dim nCount As Long
Dim nPos As Long
Dim nDelimiterLength As Long
Dim nStart As Long
Dim sOutput() As String
  
If nLimit = 0 Then
    Split = Array()
Else
    nDelimiterLength = Len(sDelimiter)
    
    If nDelimiterLength = 0 Then
        Split = Array(sInput)
    Else
        nStart = 1
        nPos = InStr(nStart, sInput, sDelimiter, bCompare)
    
    Do While nPos
      
    ReDim Preserve sOutput(0 To nCount) As String
      
        If nCount + 1 = nLimit Then
            sOutput(nCount) = Mid(sInput, nStart)
            Exit Do
        Else
            sOutput(nCount) = Mid(sInput, nStart, nPos - nStart)
            nStart = nPos + nDelimiterLength
        End If
      
    nCount = nCount + 1
      
    nPos = InStr(nStart, sInput, sDelimiter, bCompare)
      
    Loop
      
    ReDim Preserve sOutput(0 To nCount) As String
      
    sOutput(nCount) = Mid(sInput, nStart)
      
    Split = sOutput
      
    End If
  
End If
  
End Function
Personal tools