Sub 统计()
Dim s As Worksheet
Dim i As Integer, j As Integer
Set s = Worksheets("统计")
For i = 2 To 3
For j = 3 To 9
s.Cells(i, j) = 0
Next
Next
i = 8
Application.ScreenUpdating = False
With Worksheets("数据")
Do While .Cells(i, 1) <> ""
'科目余额统计
For j = 2 To 3
If s.Cells(j, 2) = Mid(.Cells(i, 1), 5, 3) Then
s.Cells(j, 3) = s.Cells(j, 3) + .Cells(i, 8)
s.Cells(j, 4) = s.Cells(j, 4) + 1
End If
Next
'自然人/企业贷款统计
If Len(.Cells(i, 2)) <= 3 Then
s.Cells(2, 5) = s.Cells(2, 5) + .Cells(i, 8)
s.Cells(3, 5) = s.Cells(3, 5) + 1
Else
s.Cells(4, 5) = s.Cells(4, 5) + .Cells(i, 8)
s.Cells(5, 5) = s.Cells(5, 5) + 1
End If
'金融业内人士贷款统计
If .Cells(i, 3) = "人行" Or .Cells(i, 3) = "工行" Or .Cells(i, 3) = "中行" Or .Cells(i, 3) = "建行" Or .Cells(i, 3) = "联社" Then
s.Cells(2, 6) = s.Cells(2, 6) + .Cells(i, 8)
s.Cells(3, 6) = s.Cells(3, 6) + 1
End If
'消费贷款统计
If .Cells(i, 6) = "建房" Or .Cells(i, 6) = "修房" Or .Cells(i, 6) = "购房" Or .Cells(i, 6) = "购车" Then
s.Cells(2, 7) = s.Cells(2, 7) + .Cells(i, 8)
s.Cells(3, 7) = s.Cells(3, 7) + 1
End If
'本年贷款发放金额和笔数统计
If Left(.Cells(i, 1), 4) = "2003" Then
s.Cells(2, 8) = s.Cells(2, 8) + .Cells(i, 8)
s.Cells(3, 8) = s.Cells(3, 8) + 1
End If
'年度到期贷款金额、笔数统计
If Left(.Cells(i, 7), 4) = "2003" Then
s.Cells(2, 9) = s.Cells(2, 9) + .Cells(i, 8)
s.Cells(3, 9) = s.Cells(3, 9) + 1
End If
'最大10户贷款统计稍微麻烦,留给大家讨论最佳方案
i = i + 1
Loop
s.Columns("a:i").AutoFit
End With
Application.ScreenUpdating = True
End Sub |