VB语言自动化处理字符串函数

'定义一个函数，把业务状况表的数据加载到字典里
Public Function AddDictionary(OriginalDictionary)
    Dim Path, CurrentWorkBook, CurrentWorkSheet, CurrentName
    Dim str1, str2, str3, str4, str5, str6
    Dim n
    n = 10
    '打开名称里含有业务状况表的表格
    Path = ThisWorkbook.Path & "\*业务状况表*"
    'Dir函数返回路径下的文件名称，再次调用自动查找下一个符合条件的文件
    CurrentName = Dir(Path)
    Set CurrentWorkBook = Workbooks.Open(ThisWorkbook.Path & "\" & CurrentName)
    Set CurrentWorkSheet = CurrentWorkBook.Worksheets(1)
    'VB字典的定义和应用！
    Set OriginalDictionary = CreateObject("Scripting.Dictionary")
    While CurrentWorkSheet.Cells(n, 1) <> ""
        str1 = "BD" & CurrentWorkSheet.Cells(n, 1)
        str2 = "BC" & CurrentWorkSheet.Cells(n, 1)
        str3 = "MD" & CurrentWorkSheet.Cells(n, 1)
        str4 = "MC" & CurrentWorkSheet.Cells(n, 1)
        str5 = "ED" & CurrentWorkSheet.Cells(n, 1)
        str6 = "EC" & CurrentWorkSheet.Cells(n, 1)
        OriginalDictionary.Add str1, CurrentWorkSheet.Cells(n, 3).Value
        OriginalDictionary.Add str2, CurrentWorkSheet.Cells(n, 4).Value
        OriginalDictionary.Add str3, CurrentWorkSheet.Cells(n, 5).Value
        OriginalDictionary.Add str4, CurrentWorkSheet.Cells(n, 6).Value
        OriginalDictionary.Add str5, CurrentWorkSheet.Cells(n, 7).Value
        OriginalDictionary.Add str6, CurrentWorkSheet.Cells(n, 8).Value
        n = n + 1
    Wend
    '关闭业务状况表
    CurrentWorkBook.Close
End Function
'定义一个函数，将基础项目定义的公式依逗号拆分
Public Function SplitString(m, l, CurrentWorkBook, ModelWorkSheet, CurrentWorkSheet, Dictionary, ThisWorkbook)
    Dim a, b, c, d, SumNumber, SubNumber
    Dim Crr, x, y, h, k 'h表示行次所在的列，k表示基础定义所在的列
    a = 1
    x = 1
    y = m
    SumNumber = 0
    SubNumber = 0
    '找出行次和基础定义所在的列
    Do While x < 12
    If Trim(ModelWorkSheet.Cells(l, x)) = "行次" Then
    h = x
    End If
    '基础项目定义的列开始！！！！！！！！！！！！！！！！！！
    If Trim(ModelWorkSheet.Cells(l, x)) = "基础项目定义" Then
    k = x
    Do While ModelWorkSheet.Cells(m, h) <> ""
    'k的值小于6和大于6从报表取值的列是不同的,因为加了基础项目定义的列
    If k < 6 Then
    ModelWorkSheet.Cells(m, k + 1) = CurrentWorkSheet.Cells(m, k + 1)
    Else
    ModelWorkSheet.Cells(m, k + 1) = CurrentWorkSheet.Cells(m, k)
    End If
    '基础定义的项拆分开始！
    If Left(ModelWorkSheet.Cells(m, k), 2) = "ED" Or Left(ModelWorkSheet.Cells(m, k), 2) = "EC" Then
    '把基础项目定义公式依据逗号拆分成一个一个的数组
    Crr = Split(ModelWorkSheet.Cells(m, k), ",")
    '对于每一个数组进行分析：+的部分放在SumNumber里，-的部分放在SubNumber里
    For i = 0 To UBound(Crr)
    '首先分析+的部分,a表示一个科目号码开始的位置（默认1），b表示结束的位置
    Do
    'INstr函数找出字符出现的第一个位置
    b = InStr(a, Crr(i), "+")
    If b = 0 Then
        If 0 = InStr(Crr(i), "-") Then
            b = Len(Crr(i)) + 1
            Else
            b = InStr(Crr(i), "-")
        End If
        SumNumber = Dictionary.Item(Mid(Crr(i), a, b - a)) + SumNumber
        Exit Do
        Else
        SumNumber = Dictionary.Item(Mid(Crr(i), a, b - a)) + SumNumber
        a = b + 1
     End If
     Loop While b <> 0
     '然后分析-的部分，a表示一个科目号码开始的位置，d表示结束的位置
    If InStr(Crr(i), "-") <> 0 Then
     c = InStr(Crr(i), "-") + 1
    Do
     d = InStr(c, Crr(i), "-")
     If d = 0 Then
        d = Len(Crr(i)) + 1
        SubNumber = SubNumber + Dictionary.Item(Mid(Crr(i), c, d - c))
        Exit Do
        Else
        SubNumber = SubNumber + Dictionary.Item(Mid(Crr(i), c, d - c))
        c = d + 1
     End If
    Loop While d <> 0
    End If
    '判断是否是第一个数组，第一个数组直接SumNumber - SubNumber，后面的数组需要判断扎差
    If i = 0 Then
    If Trim(ModelWorkSheet.Cells(m, 1)) = "存放同业款项" Or Trim(ModelWorkSheet.Cells(m, 6)) = "同业及其他金融机构存放款项" Then
    ModelWorkSheet.Cells(m, k + 2) = ModelWorkSheet.Cells(m, k + 2) + SumNumber - SubNumber
    ModelWorkSheet.Cells(m, k + 2) = ModelWorkSheet.Cells(m, k + 2) - ThisWorkbook.Worksheets("报表检核页").Cells(11, 13)
    Else
    ModelWorkSheet.Cells(m, k + 2) = ModelWorkSheet.Cells(m, k + 2) + SumNumber - SubNumber
    End If
    Else
    If SumNumber > SubNumber Then
    ModelWorkSheet.Cells(m, k + 2) = ModelWorkSheet.Cells(m, k + 2) + SumNumber - SubNumber
    End If
    End If
    '每一个数组分析完毕后都需要把a 、SumNumber、SubNumber重新赋值
    a = 1
    SumNumber = 0
    SubNumber = 0
    Next
    '基础定义的项拆分完毕！
    '计算公式的项赋值开始！
    Else
    If ModelWorkSheet.Cells(m, k) <> "" Then
    ModelWorkSheet.Cells(m, k + 2).Formula = "=" & ModelWorkSheet.Cells(m, k)
    End If
    '计算公式的项赋值完毕！
    End If
    '判断报表值和计算的结果是否相等，不相等则标记颜色区分
    If Round(Val(ModelWorkSheet.Cells(m, k + 1)), 2) <> Round(Val(ModelWorkSheet.Cells(m, k + 2)), 2) Then
    ModelWorkSheet.Cells(m, k + 1).Interior.ColorIndex = 3
    ModelWorkSheet.Cells(m, k + 2).Interior.ColorIndex = 3
    End If
    m = m + 1
    Loop
    'm的循环结束后需要把m重新赋值！
    m = y
    End If
    '基础项目定义的列结束！！！！！！！！！！！！！！！！！！
    x = x + 1
    Loop
    CurrentWorkBook.Close
End Function