|
|
|
Sub total()
Dim Sql$, line&, i&
Application.ScreenUpdating = False
Set xx = CreateObject("adodb.connection")
With xx
.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
Sql = "select 品号,品名,sum(数量),sum(金额),类型 from [明细$] where month(日期)=" & Month(ActiveSheet.[j2]) & " group by 品号,品名,类型 order by 品号,类型 desc"
[a5].CopyFromRecordset .Execute(Sql)
Sql = "select 品号,sum(数量),sum(金额),类型 from [明细$] group by 品号,品名,类型 order by 品号,类型 desc"
[k5].CopyFromRecordset .Execute(Sql)
For i = 5 To [e65536].End(xlUp).Row
If Cells(i, 5) = "退货" Then '将退货记录移到右边
If Cells(i, 1) <> Cells(i - 1, 1) Then
Range(Cells(i, 3), Cells(i, 4)).Copy Destination:=Cells(i, 7)
Range(Cells(i, 3), Cells(i, 4)).Clear
Else
Range(Cells(i, 3), Cells(i, 4)).Copy Destination:=Cells(i - 1, 7)
Range(Cells(i, 1), Cells(i, 5)).Delete
i = i - 1
End If
End If
Next
For i = 5 To [e65536].End(xlUp).Row
If Cells(i, 14) = "销售" Then '将累计销售记录原样复制到指定位置
Range(Cells(i, 12), Cells(i, 13)).Copy Destination:=Cells(i, 5)
Else
If Cells(i, 11) <> Cells(i - 1, 11) Then '将退货记录移到右边
Range(Cells(i, 12), Cells(i, 13)).Copy Destination:=Cells(i, 9)
Cells(i, 5).Clear
Else
Range(Cells(i, 12), Cells(i, 13)).Copy Destination:=Cells(i - 1, 9)
Range(Cells(i, 11), Cells(i, 14)).Delete
i = i - 1
End If
End If
Next
Range(Cells(5, 11), Cells(65536, 14)).Clear '清除临时数据
line = [a65536].End(xlUp).Row
Range(Cells(line + 1, 1), Cells(65536, 10)).Clear
Range(Cells(5, 1), Cells(line, 10)).Select '下面是录制的宏用来给整个数据区域加框线
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
.Close
Set xx = Nothing
Application.ScreenUpdating = True
End With
End Sub
其中 Sql = "select 品号,品名,sum(数量),sum(金额),类型 from [明细$] where month(日期)=" & Month(ActiveSheet.[j2]) & " group by 品号,品名,类型 order by 品号,类型 desc"
蓝色部分是根据 J2 的月份查询当月数据
红色部分是根据 品号,品名,类型 分类汇总
绿色部分是按 品号,类型 降序排序
分两次把当月和累积的数据筛选出来后,由于进货退货都在同一列上，所以下面的工作就是将退货记录移到要求的位置，并从进货部分删除。
你把“清除临时数据”那一句注解掉，就可以看到第一次筛选出来的数据排列情况。 |
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2006-3-27 15:26
楼主
