|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
回复 1楼 xyd617 的帖子
以下是“08调整分录”里面的代码,其他地方没有代码:
Sub 分录()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim i As Integer
Dim j As Integer
Dim m As Integer
Set sh1 = Worksheets("往来差异对比表 (审定数)")
Set sh2 = Worksheets("08调整分录")
j = 6
For m = 2 To 17
i = 6
Do
If sh1.Cells(i, 19) < sh1.Cells(i, 20) And sh1.Cells(i, m) <> 0 And Abs(sh1.Cells(i, 9)) < 0.005 And (m = 2 Or m = 3 Or m = 4) Then
sh2.Cells(j, 5).Value = sh1.Cells(3, m)
sh2.Cells(j, 9).Value = sh1.Cells(i, m)
sh2.Cells(j, 7).Value = sh1.Cells(i, 1)
sh2.Cells(j, 2).Value = sh1.Cells(i, 24)
j = j + 1
ElseIf sh1.Cells(i, 19) < sh1.Cells(i, 20) And sh1.Cells(i, m) <> 0 And Abs(sh1.Cells(i, 9)) < 0.005 And (m = 12 Or m = 13 Or m = 14) Then
sh2.Cells(j, 5).Value = sh1.Cells(3, m)
sh2.Cells(j, 9).Value = sh1.Cells(i, m)
sh2.Cells(j, 7).Value = sh1.Cells(i, 11)
sh2.Cells(j, 2).Value = sh1.Cells(i, 24)
j = j + 1
ElseIf sh1.Cells(i, 19) < sh1.Cells(i, 20) And sh1.Cells(i, m) <> 0 And Abs(sh1.Cells(i, 9)) < 0.005 And (m = 5 Or m = 6 Or m = 7) Then
sh2.Cells(j, 5).Value = sh1.Cells(3, m)
sh2.Cells(j, 8).Value = sh1.Cells(i, m)
sh2.Cells(j, 7).Value = sh1.Cells(i, 1)
sh2.Cells(j, 2).Value = sh1.Cells(i, 24)
j = j + 1
ElseIf sh1.Cells(i, 19) < sh1.Cells(i, 20) And sh1.Cells(i, m) <> 0 And Abs(sh1.Cells(i, 9)) < 0.005 And (m = 15 Or m = 16 Or m = 17) Then
sh2.Cells(j, 5).Value = sh1.Cells(3, m)
sh2.Cells(j, 8).Value = sh1.Cells(i, m)
sh2.Cells(j, 7).Value = sh1.Cells(i, 11)
sh2.Cells(j, 2).Value = sh1.Cells(i, 24)
j = j + 1
End If
i = i + 1
Loop Until sh1.Cells(i, 1) = ""
j = j
Next m
End Sub
Sub 排序()
Rows("6:462").Select
Selection.Sort Key1:=Range("B6"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
End Sub
Private Sub CommandButton1_Click()
Application.Run "内部往来自动抵消.xls!Sheet1.分录"
Application.Run "内部往来自动抵消.xls!Sheet1.排序"
MsgBox " 计算完成!"
End Sub |
|