BreadCrumbs: Excel
Excel
From Luke Jackson
(Difference between revisions)
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