|
Public Sub GetEndVch(strGroup As String, strMaker As String) '结转损益
Dim iYear As Integer
Dim iPeriod As Integer
Dim strProfitandLossNum As String
Dim strProfitandLossFullName As String
Dim iMaxVchNum As Integer
Dim iRowNum As Integer
Dim dblAmount As Double
Dim strCord As String
Dim dteDate As Date
Dim strAccType As String
Dim strAccNum As String
Dim strAccFullName As String
Dim i As Integer
Dim m As Integer
Dim n As Integer
Dim dblTotalAmount As Double
strProfitandLossNum = Sheet15.Cells(9, 3)
Dim lAccRow As Long
Set r = Sheet12.Columns("B:B").Find(strProfitandLossNum, LookAt:=xlWhole)
If Not r Is Nothing Then
lAccRow = Sheet12.Columns("B:B").Find(strProfitandLossNum, LookAt:=xlWhole).Row
strProfitandLossFullName = Sheet12.Cells(lAccRow, 3)
Else
lAccRow = 0
MsgBox "本年利润科目没有设置或设置错误!"
Exit Sub
End If
iCurrentYear = GetCurrentYear()
iCurrentPeriod = GetCurrentPeriod()
dteDate = GetMaxDate(iCurrentYear, iCurrentPeriod)
iMaxVchNum = GetVchMaxNum
m = 0
'判断损益类科目是否有余额
Dim lAccRows As Long
Dim lVchRows As Long
Dim d
lAccRows = Sheet12.Cells(Rows.Count, 2).End(xlUp).Row
lVchRows = Sheet17.Cells(Rows.Count, 2).End(xlUp).Row
Set d = CreateObject("Scripting.Dictionary")
For l = 3 To lVchRows
strAccNum = Sheet17.Cells(l, 9)
iYear = CInt(Sheet17.Cells(l, 2))
iPeriod = CInt(Sheet17.Cells(l, 3))
If iPeriod = iCurrentPeriod And iYear = iCurrentYear Then
Set r = Sheet12.Columns("B:B").Find(strAccNum, LookAt:=xlWhole)
If Not r Is Nothing Then
lAccRow = Sheet12.Columns("B:B").Find(strAccNum, LookAt:=xlWhole).Row
strAccType = Sheet12.Cells(lAccRow, 5)
strCord = Sheet12.Cells(lAccRow, 6)
If strAccType = "损益" Then
If strCord = "借方" Then
dblAmount = Sheet17.Cells(l, 11)
Else
dblAmount = Sheet17.Cells(l, 12)
End If
d(strAccNum) = d(strAccNum) + dblAmount
End If
End If
End If
Next
Set r = Nothing
k = d.Keys
t = d.items
n = d.Count
iRowNum = 1
dblTotalAmount = 0
If n = 0 Then
MsgBox ("本期损益类科目发生额为零,无需结转")
Exit Sub
Else
With Sheet17
For i = 1 To n
strAccNum = k(i - 1)
dblAmount = t(i - 1)
Set r = Sheet12.Columns("B:B").Find(strAccNum, LookAt:=xlWhole)
If Not r Is Nothing Then
lAccRow = Sheet12.Columns("B:B").Find(strAccNum, LookAt:=xlWhole).Row
strAccFullName = Sheet12.Cells(lAccRow, 4)
strAccType = Sheet12.Cells(lAccRow, 5)
strCord = Sheet12.Cells(lAccRow, 6)
'写入记录
.Cells(lVchRows + 1, 2) = iCurrentYear
.Cells(lVchRows + 1, 3) = iCurrentPeriod
.Cells(lVchRows + 1, 4) = dteDate
.Cells(lVchRows + 1, 5) = strGroup
.Cells(lVchRows + 1, 6) = iMaxVchNum + 1
.Cells(lVchRows + 1, 7) = iRowNum
.Cells(lVchRows + 1, 8) = "结转损益"
.Cells(lVchRows + 1, 9) = strAccNum
.Cells(lVchRows + 1, 10) = strAccFullName
.Cells(lVchRows + 1, 11) = IIf(strCord = "借方", 0, dblAmount)
.Cells(lVchRows + 1, 12) = IIf(strCord = "贷方", 0, dblAmount)
.Cells(lVchRows + 1, 13) = 0
.Cells(lVchRows + 1, 14) = strMaker
.Cells(lVchRows + 1, 15) = ""
.Cells(lVchRows + 1, 16) = ""
.Cells(lVchRows + 1, 17) = 0
.Cells(lVchRows + 1, 18) = 0
End If
lVchRows = lVchRows + 1
iRowNum = iRowNum + 1
If strCord = "借方" Then
dblTotalAmount = dblTotalAmount - dblAmount
Else
dblTotalAmount = dblTotalAmount + dblAmount
End If
Next
If dblTotalAmount <> 0 Then
.Cells(lVchRows + 1, 2) = iCurrentYear
.Cells(lVchRows + 1, 3) = iCurrentPeriod
.Cells(lVchRows + 1, 4) = dteDate
.Cells(lVchRows + 1, 5) = strGroup
.Cells(lVchRows + 1, 6) = iMaxVchNum + 1
.Cells(lVchRows + 1, 7) = iRowNum
.Cells(lVchRows + 1, 8) = "结转损益"
.Cells(lVchRows + 1, 9) = strProfitandLossNum
.Cells(lVchRows + 1, 10) = strProfitandLossFullName
.Cells(lVchRows + 1, 11) = 0
.Cells(lVchRows + 1, 12) = dblTotalAmount
.Cells(lVchRows + 1, 13) = 0
.Cells(lVchRows + 1, 14) = strMaker
.Cells(lVchRows + 1, 15) = ""
.Cells(lVchRows + 1, 16) = ""
.Cells(lVchRows + 1, 17) = 0
.Cells(lVchRows + 1, 18) = 0
lVchRows = lVchRows + 1
iRowNum = iRowNum + 1
End If
MsgBox ("结转损益成功,凭证号为:" & strGroup & iMaxVchNum + 1)
End With
End If
End Sub
|
评分
-
1
查看全部评分
-
|