''--------------------------------------------------------------------------
'Author: Nguyen Duy Tuan - www.bluesofts.net
'--------------------------------------------------------------------------
Option Explicit
Function TextFromTo(ByVal cText As String) As String
Dim ArrText
Dim lb&, ub&, I&, P1&
Dim cFirstValue$, cText1$, cTextRet$
Dim FirstNum&, lNum&
'cText = "150001-3,15,16,28-29"
ArrText = Split(cText, ",")
lb = LBound(ArrText, 1)
ub = UBound(ArrText, 1)
cFirstValue = ArrText(lb)
P1 = InStr(cFirstValue, "-")
If P1 > 0 Then
cFirstValue = Left$(cFirstValue, P1 - 1)
End If
For I = Len(cFirstValue) To 1 Step -1
If Not IsNumeric(Mid(cFirstValue, I)) Then
FirstNum = I
Exit For
End If
Next I
FirstNum = FirstNum + 1
If FirstNum > 1 Then
cText1$ = Left(cFirstValue, FirstNum - 1)
Else
cText1$ = ""
End If
lNum = CLng(Mid(cFirstValue, FirstNum))
For I = lb To ub
If ArrText(I) <> "" Then
cTextRet = GetText(cFirstValue, cText1, lNum, ArrText(I))
If cTextRet <> "" Then
If TextFromTo = "" Then
TextFromTo = cTextRet
Else
TextFromTo = TextFromTo & "," & cTextRet
End If
End If
End If
Next I
End Function
'--------------------------------------------------------------------------
Function GetText(ByVal cFirstValue As String, ByVal cFirstText As String, ByVal lNum As Long, ByVal cSubText As String) As String
Dim ArrText
Dim cText$
Dim I&, lb&, ub&, lNum1&, lNum2&
Dim nLenthText&
nLenthText = Len(cFirstValue)
ArrText = Split(cSubText, "-")
lb = LBound(ArrText, 1)
ub = UBound(ArrText, 1)
If (ub - lb = 0) Then
If (ArrText(lb) = cFirstValue) Then
GetText = ArrText(lb)
Else
If IsNumeric(ArrText(ub)) Then
lNum2 = CLng(ArrText(ub))
If lNum2 < lNum Then lNum2 = lNum + lNum2 - IIf(lNum Mod 10 = 0, 0, 1)
GetText = FillName(nLenthText, cFirstText, CStr(lNum2))
Else
GetText = FillName(nLenthText, cFirstText, ArrText(ub))
End If
End If
Exit Function
ElseIf ArrText(lb) = cFirstValue Then
If IsNumeric(ArrText(ub)) Then
lNum2 = CLng(ArrText(ub))
End If
If lNum2 < lNum Then lNum2 = lNum + lNum2 - IIf(lNum Mod 10 = 0, 0, 1)
For I = lNum To lNum2
cText = FillName(nLenthText, cFirstText, CStr(I))
If I = lNum Then
GetText = cText
Else
GetText = GetText & "," & cText
End If
Next I
Exit Function
End If
If IsNumeric(ArrText(lb)) Then
lNum1 = CLng(ArrText(lb))
End If
If IsNumeric(ArrText(ub)) Then
lNum2 = CLng(ArrText(ub))
End If
If lNum1 < lNum Then lNum1 = lNum + lNum1 - 1 + IIf(lNum Mod 10 = 0, 1, 0)
If lNum2 < lNum Then lNum2 = lNum + lNum2 - IIf(lNum Mod 10 = 0, 0, 1)
For I = lNum1 To lNum2
cText = FillName(nLenthText, cFirstText, CStr(I))
If GetText <> "" Then
GetText = GetText & "," & cText
Else
GetText = cText
End If
Next I
End Function
'--------------------------------------------------------------------------
Function FillName(ByVal nLengthText As Long, ByVal Text1 As String, ByVal Text2 As String, Optional ByVal CharToFill As String = "0")
Dim nLen&
nLen = Len(Text1) + Len(Text2)
If nLen < nLengthText Then
FillName = Text1 & String$(nLengthText - nLen, CharToFill) & Text2
Else
FillName = Text1 & Text2
End If
End Function
