'Author: Le Duc Hong         http://www.vovisoft.com

Option Explicit

Private SText As String

Private SDelimiter As String

Private IPos As Integer

Private ILen As Integer

Public MaxToken As Integer

Private Tokens() As String

Public Property Get Text() As Variant

   Text = SText

End Property

Public Property Let Text(ByVal vNewValue As Variant)

   SText = vNewValue

   ILen = Len(SText): IPos = 1

End Property

Public Property Get Delimiter() As Variant

   Delimiter = SDelimiter

End Property

Public Function TokenAt(TNum) As String

   If (TNum > 0) And (TNum <= MaxToken) Then

      TokenAt = Tokens(TNum)

   Else

      TokenAt = ""

   End If

End Function

Public Property Let Delimiter(ByVal vNewValue As Variant)

   SDelimiter = vNewValue

   Tokenise

End Property

Private Sub Tokenise()

   Dim i

   i = 0: IPos = 1

   Do Until IPos > ILen

      i = i + 1

      ReDim Preserve Tokens(i)

      Tokens(i) = GetToken

   Loop

   MaxToken = i

   IPos = 1

End Sub

Public Sub ReplaceToken(TNum, NewToken)

   If (TNum > 0) And (TNum <= MaxToken) Then

      Tokens(TNum) = NewToken

      ReconstructText

   End If

End Sub

Private Sub ReconstructText()

   Dim i

   SText = ""

   For i = 1 To MaxToken

      SText = SText & Tokens(i)

      If i < MaxToken Then SText = SText & SDelimiter

   Next

End Sub

Public Function KeepLeftPart(NumChar) As String

   If ILen >= NumChar Then

      SText = Left(SText, NumChar): ILen = Len(SText)

   End If

   KeepLeftPart = SText

End Function

Public Function KeepRightPart(NumChar) As String

   If ILen >= NumChar Then

      SText = Right(SText, NumChar): ILen = Len(SText)

   End If

   KeepRightPart = SText

End Function

Public Function KeepMidPart(SPos, NumChar) As String

   If ILen >= SPos Then

      SText = Mid(SText, SPos): ILen = Len(SText)

   End If

   If ILen >= NumChar Then

      SText = Right(SText, NumChar)

   End If

   KeepMidPart = SText

End Function

Public Property Get CurrentPos() As Variant

   CurrentPos = IPos

End Property

Public Property Let CurrentPos(ByVal vNewValue As Variant)

   IPos = vNewValue

End Property

Public Function GetToken() As String

   Dim Pos

   GetToken = ""

   If SDelimiter = " " Then

      Do While Mid(SText, IPos, 1) = " "

         IPos = IPos + 1

         If IPos > ILen Then

            Exit Function

         End If

      Loop

   End If

   Pos = InStr(IPos, SText, SDelimiter)

   If Pos > 0 Then

      GetToken = Mid(SText, IPos, Pos - IPos)

      IPos = Pos + Len(SDelimiter)

   Else

      GetToken = Mid(SText, IPos, ILen - IPos + 1)

      IPos = ILen + 1

   End If

End Function

Public Sub Substitude(Param, ParamValue)

   Dim Pos, PLen

   PLen = Len(Param)

   Pos = InStr(SText, Param)

   Do While Pos > 0

      SText = Left(SText, Pos - 1) & ParamValue & Mid(SText, Pos + PLen)

      Pos = InStr(SText, Param)

   Loop

   ILen = Len(SText)

End Sub

Public Function GetLastToken() As String

   Dim Pos, Tlen

   Tlen = Len(SDelimiter)

   GetLastToken = ""

   If ILen = 0 Then

      Exit Function

   End If

   Pos = ILen - Tlen + 1

   Do While Pos > 0

      If Mid(SText, Pos, Tlen) = SDelimiter Then

         GetLastToken = Mid(SText, Pos + Tlen)

      End If

      Pos = Pos - 1

   Loop

End Function

Public Property Get Length() As Integer

   Length = ILen

End Property

Public Property Get TokenCount() As Variant

   TokenCount = MaxToken

End Property

Public Function Chamcong(ByVal Khoang As Range, ByVal Chucnang As String) As Single

Dim Socot As Integer, Sohang As Integer

Dim i As Integer, j As Integer, k As Integer

Dim Btotal As Single

Dim Bgiatriso As Single

Dim Bchucnang As String

Dim SoLoai As Byte ' Bien nay nham xac dinh so loai ngay nghi, tang ca... trong mot chuoi

Dim BChuoi As clsString

Dim BGiatri

On error resume next

'Xac dinh so cot trong bien Khoang

Socot = Khoang.Columns.Count

'Xac dinh so hang trong bien Khoang

Sohang = Khoang.Rows.Count

' Nham bao dam so sanh dung ta dung ham UCase

Chucnang = UCase(Chucnang)

'Duyet qua cac cell trong bien Khoang

For i = 1 To Sohang

    For j = 1 To Socot

        BGiatri = Khoang.Cells(i, j).Value

        BGiatri = Trim(BGiatri)

        ' Bat dau xu ly bgiatri qua Class clsString

        Set BChuoi = New clsString

        BChuoi.Text = BGiatri

        'Ky tu de phan cach cac Chuc nang

        BChuoi.Delimiter = ";"

        'Xac dinh so Chuc nang trong 1 cell

        SoLoai = BChuoi.TokenCount

        For k = 1 To SoLoai

            'Chuoi cua tung chuc nang

            BGiatri = BChuoi.TokenAt(k)

            Bchucnang = UCase(Left(BGiatri, Len(Chucnang)))

            Bgiatriso = Val(Right(BGiatri, Len(BGiatri) - len(Chucnang)))

            Select Case Bchucnang

                Case Chucnang

                    Btotal = Btotal + Bgiatriso

            End Select

        Next k

    Next j

Next i

Chamcong = Btotal

End Function