'定義一個(gè)函數，把業(yè)務(wù)狀況表的數據加載到字典里
Public Function AddDictionary(OriginalDictionary)
Dim Path, CurrentWorkBook, CurrentWorkSheet, CurrentName
Dim str1, str2, str3, str4, str5, str6
Dim n
n = 10
'打開(kāi)名稱(chēng)里含有業(yè)務(wù)狀況表的表格
Path = ThisWorkbook.Path & "\*業(yè)務(wù)狀況表*"
'Dir函數返回路徑下的文件名稱(chēng)，再次調用自動(dòng)查找下一個(gè)符合條件的文件
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
'關(guān)閉業(yè)務(wù)狀況表
CurrentWorkBook.Close
End Function
'定義一個(gè)函數，將基礎項目定義的公式依逗號拆分
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
'基礎項目定義的列開(kāi)始?。。。。。。。。。。。。。。。。?！
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
'基礎定義的項拆分開(kāi)始！
If Left(ModelWorkSheet.Cells(m, k), 2) = "ED" Or Left(ModelWorkSheet.Cells(m, k), 2) = "EC" Then
'把基礎項目定義公式依據逗號拆分成一個(gè)一個(gè)的數組
Crr = Split(ModelWorkSheet.Cells(m, k), ",")
'對于每一個(gè)數組進(jìn)行分析：+的部分放在SumNumber里，-的部分放在SubNumber里
For i = 0 To UBound(Crr)
'首先分析+的部分,a表示一個(gè)科目號碼開(kāi)始的位置（默認1），b表示結束的位置
Do
'INstr函數找出字符出現的第一個(gè)位置
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表示一個(gè)科目號碼開(kāi)始的位置，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
'判斷是否是第一個(gè)數組，第一個(gè)數組直接SumNumber - SubNumber，后面的數組需要判斷扎差
If i = 0 Then
If Trim(ModelWorkSheet.Cells(m, 1)) = "存放同業(yè)款項" Or Trim(ModelWorkSheet.Cells(m, 6)) = "同業(yè)及其他金融機構存放款項" 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("報表檢核頁(yè)").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
'每一個(gè)數組分析完畢后都需要把a 、SumNumber、SubNumber重新賦值
a = 1
SumNumber = 0
SubNumber = 0
Next
'基礎定義的項拆分完畢！
'計算公式的項賦值開(kāi)始！
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的循環(huán)結束后需要把m重新賦值！
m = y
End If
'基礎項目定義的列結束?。。。。。。。。。。。。。。。。?！
x = x + 1
Loop
CurrentWorkBook.Close
End Function
本站僅提供存儲服務(wù)，所有內容均由用戶(hù)發(fā)布，如發(fā)現有害或侵權內容，請
點(diǎn)擊舉報。
