似水流年

决定是网络了，就算最后一次奢侈吧~

从今天开始请假，到25号，静心修炼啊~~

但晚上有事，只好又来加班了
加班内容是写一个自动算累计应收款表的程序，现在把成果拿出来晒晒,和那个工资条的一起，嘿嘿

累计应收款：

Sub duquyingshou()
Application.ScreenUpdating = False
Dim i As Integer
Dim j As Integer
Dim c As Integer
Dim o As Integer
Dim count1 As Integer
Dim count2 As Integer
Dim k As String
Dim day1 As Integer
‘Workbooks.Open “发货单列表.XLS”
‘Workbooks(“应收帐款明细表.xls” .Activate
‘MergeCells = True  合并单元格

Sheets(“应收帐款明细表” .Select
Cells.Select
Selection.Copy
Sheets(“备份应收帐款明细表” .Select
Cells.Select
ActiveSheet.Paste

Sheets(“应收帐款明细表” .Select
count1 = [a65536].End(xlUp).Row
Sheets(“发货明细” .Select
count2 = [a65536].End(xlUp).Row

Cells.Select
Selection.Sort Key1:=Range(“C2” , Order1:=xlAscending, Key2:=Range(“A2”  _
, Order2:=xlDescending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
, Orientation:=xlTopToBottom, SortMethod:=xlPinYin, DataOption1:= _
xlSortNormal, DataOption2:=xlSortNormal
j = 2
Do While j < count2
‘For j = 2 To count2
For i = 5 To count1
If Sheets(“应收帐款明细表” .Cells(i, 2).Value = Cells(j, 3).Value Then
If Sheets(“应收帐款明细表” .Cells(i, 5) = Cells(j, 7) And Sheets(“应收帐款明细表” .Cells(i, 6) = Cells(j, 8) And Sheets(“应收帐款明细表” .Cells(i, 7) = Cells(j, 24) Then
If Day(Cells(j, 1)) = Sheets(“应收帐款明细表” .Cells(i, 8).Value Then
For o = 9 To 20
If Month(Cells(j, 1)) = (o – 8) Then
Sheets(“应收帐款明细表” .Cells(i, o).Value = Sheets(“应收帐款明细表” .Cells(i, o).Value + Cells(j, 10).Value
End If
Next o
Exit For
ElseIf Day(Cells(j, 1)) < Sheets(“应收帐款明细表” .Cells(i, 8).Value Then
Sheets(“应收帐款明细表” .Select
Rows(i).Select
Selection.Insert shift:=xlDown
For c = 1 To 7
Cells(i, c).Value = Cells(i + 1, c).Value
Next c
Cells(i, 8).Value = Day(Sheets(“发货明细” .Cells(j, 1))
Sheets(“发货明细” .Select
For o = 9 To 20
If Month(Cells(j, 1)) = (o – 8) Then
Sheets(“应收帐款明细表” .Cells(i, o).Value = Sheets(“应收帐款明细表” .Cells(i, o).Value + Cells(j, 10).Value
End If
Next o
count1 = count1 + 1
Exit For
ElseIf Day(Cells(j, 1)) > Sheets(“应收帐款明细表” .Cells(i, 8).Value Then
Sheets(“应收帐款明细表” .Select
Rows(i + 1).Select
Selection.Insert shift:=xlDown
Cells(i + 1, 1).Value = Cells(i, 1).Value
Cells(i + 1, 2).Value = Sheets(“发货明细” .Cells(j, 3).Value
Cells(i + 1, 3).Value = Sheets(“发货明细” .Cells(j, 4).Value
Cells(i + 1, 4).Value = Sheets(“发货明细” .Cells(j, 5).Value
Cells(i + 1, 5).Value = Sheets(“发货明细” .Cells(j, 7).Value
Cells(i + 1, 6).Value = Sheets(“发货明细” .Cells(j, 8).Value
Cells(i + 1, 7).Value = Sheets(“发货明细” .Cells(j, 24).Value
Cells(i + 1, 8).Value = Day(Sheets(“发货明细” .Cells(j, 1))
Sheets(“发货明细” .Select
For o = 9 To 20
If Month(Cells(j, 1)) = (o – 8) Then
Sheets(“应收帐款明细表” .Cells(i + 1, o).Value = Sheets(“应收帐款明细表” .Cells(i + 1, o).Value + Cells(j, 10).Value
End If
Next o
count1 = count1 + 1
Exit For
End If
Else
Sheets(“应收帐款明细表” .Select
Rows(i + 1).Select
Selection.Insert shift:=xlDown
Cells(i + 1, 1).Value = Cells(i, 1).Value
Cells(i + 1, 2).Value = Sheets(“发货明细” .Cells(j, 3).Value
Cells(i + 1, 3).Value = Sheets(“发货明细” .Cells(j, 4).Value
Cells(i + 1, 4).Value = Sheets(“发货明细” .Cells(j, 5).Value
Cells(i + 1, 5).Value = Sheets(“发货明细” .Cells(j, 7).Value
Cells(i + 1, 6).Value = Sheets(“发货明细” .Cells(j, 8).Value
Cells(i + 1, 7).Value = Sheets(“发货明细” .Cells(j, 24).Value
Cells(i + 1, 8).Value = Day(Sheets(“发货明细” .Cells(j, 1))
Sheets(“发货明细” .Select
For o = 9 To 20
If Month(Cells(j, 1)) = (o – 8) Then
Sheets(“应收帐款明细表” .Cells(i + 1, o).Value = Sheets(“应收帐款明细表” .Cells(i + 1, o).Value + Cells(j, 10).Value
End If
Next o
count1 = count1 + 1
Exit For
End If
End If
Next i
j = j + 1

‘Next j
Loop
Sheets(“应收帐款明细表” .Select

Cells(1, 1).Select
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
Sub hesuan()
Application.ScreenUpdating = False
Dim i As Integer
Dim j As Integer
Dim c As Integer
Dim count1 As Integer
Dim count2 As Integer
Dim k As String
Dim day1 As Integer
Dim month1 As Integer
Sheets(“应收帐款明细表” .Select
count1 = [a65535].End(xlUp).Row
For i = 5 To count1
k = Cells(i, 5)
Select Case k
Case “现金”
For j = 9 To 20
Cells(i, j).Font.ColorIndex = 3
Cells(i, 22) = Cells(i, 22) + Cells(i, j)
Cells(i, 21) = Cells(i, 21) + Cells(i, j)
Next j
Case “预付”
For j = 9 To 20
Cells(i, j).Font.ColorIndex = 3
Cells(i, 22) = Cells(i, 22) + Cells(i, j)
Cells(i, 21) = Cells(i, 21) + Cells(i, j)
Next j
Case “快递托收款”
For j = 9 To 20
Cells(i, j).Font.ColorIndex = 3
Cells(i, 22) = Cells(i, 22) + Cells(i, j)
Cells(i, 21) = Cells(i, 21) + Cells(i, j)
Next j
Case “货到”
For j = 9 To 20
Cells(i, 21) = Cells(i, 21) + Cells(i, j)
If Date > DateSerial(2006, j – 8, (Cells(i, 8) + Cells(i, 7))) Then
Cells(i, j).Font.ColorIndex = 3
Cells(i, 22) = Cells(i, 22) + Cells(i, j)
End If
Next j
Case “月结”
For j = 9 To 20
Cells(i, 21) = Cells(i, 21) + Cells(i, j)
If Date > DateSerial(2006, j – 7, Cells(i, 6)) Then
Cells(i, j).Font.ColorIndex = 3
Cells(i, 22) = Cells(i, 22) + Cells(i, j)
End If
Next j
End Select
Next i

Sheets(“应收帐款明细表” .Select
Cells(1, 1).Select
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub

Sub huifu()
Application.ScreenUpdating = False
Sheets(“备份应收帐款明细表” .Select
Cells.Select
Selection.Copy
Sheets(“应收帐款明细表” .Select
Cells.Select
ActiveSheet.Paste
Cells(1, 1).Select
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub

工资条
Private Sub CommandButton1_Click()

Dim r As Long, LastRow As Long
Dim j As Long

Application.ScreenUpdating = False
LastRow = Sheets(“试题3” .Range(“A65536” .End(xlUp).Row
r = 6
If Cells(6, 1) <> “” Then
Do While r <= LastRow
Range(“2:4” .Select
Selection.Copy
j = r + 2
Range(Cells(r, 1), Cells(j, 1)).Select
Selection.EntireRow.Select
Selection.Insert Shift:=xlDown
LastRow = LastRow + 3
r = r + 4
Loop
End If
Cells(1, 1).Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
CommandButton1.Enabled = False
CommandButton2.Enabled = True
End Sub

Private Sub CommandButton2_Click()

Dim r As Long, LastRow As Long
Dim j As Long

Application.ScreenUpdating = False
LastRow = Sheets(“试题3” .Range(“A65536” .End(xlUp).Row
r = 6
If Cells(6, 1) = “” Then
Do While r <= LastRow
j = r + 2
Range(Cells(r, 1), Cells(j, 1)).Select
Selection.EntireRow.Select
Selection.Delete Shift:=xlDown
r = r + 1
LastRow = LastRow – 3
Loop
End If
Cells(1, 1).Select
Application.ScreenUpdating = True
CommandButton1.Enabled = True
CommandButton2.Enabled = False
End Sub

PS:问题止于方法
成功源于责任