发货清单明细表表格（产品发货明细表）

最近经常使用Excel工作簿，需要频繁的查询数据，于是编写了几个VBA模块，结果发现不但Excel不再卡顿，而且极大地方便了查询，提高了效率。

一、基础数据

在成品出库工作表中记录了客户提货明细等数据，如下图。

图1 基础数据表

二、查询界面

即对账单工作表，如下图：

图2 发货明细

虚线区域为打印设置区域。

在B2单元格输入要查询的客户名称，回车，即可一键查询发货明细（这里使用了worksheet的change事件，只要B2单元格发生变化，即执行发货明细查询代码，当然也可设置对账单查询代码）。点击对账单汇总按钮即可一键查询客户对账单情况，如下图：

图3 对账单汇总

点击预览按钮：

图4 预览效果

另存为xls格式文件：

图5

另存为PDF格式文件：

图6

三、实现方法

1、提货明细模块代码如下：

Option Explicit

Sub Findrecords_Click()

'模块名称

Dim i As Integer, j As Integer, k%,irow%,irow2%,m%

Dim sh1 As Worksheet,sh2 As Worksheet

Dim arr()

'定义变量

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

'关闭屏幕更新和自动计算

Set sh1 = Sheets("成品出库")

Set sh2 = Sheets("对账单")

'对象赋值

If sh2.Range("B2").Value = "" Then

MsgBox "Please input customer name."

Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic

Exit Sub

End If

'判断语句，如果B2单元格为空时，提示您请输入要查询的客户名称。

irow = sh1.Range("C65536").End(xlUp).Row

sh2.Range("A1:P1").Clear

sh2.Range("C2:P2").Clear

sh2.Range("A3:P300").Clear

sh2.Range("C1").Value = "客户提货明细"

sh2.Range("C1:O1").Merge

sh2.Range("C1:O1").HorizontalAlignment = xlCenter

sh2.Range("C1:O1").VerticalAlignment = xlCenter

sh2.Range("A4:O4").Value = Array("description", "NO.", "product", "发货量", "调货", "退货量", "实销量", "单位", "单价", "货款", "垫付运费", "退货运费", "报销", "补偿", "备注")

sh2.Range("C4:O4").Borders(xlTop).LineStyle = xlContinuous

sh2.Range("C4:O4").Borders(xlBottom).LineStyle = xlContinuous

sh2.Range("N3") = Date

'查询之前先清空，然后赋值、画线、合并单元格等操作

k = 5

For i = 2 To irow

If sh1.Range("C" & i).Value Like "*" & sh2.Range("B2").Value & "*" Or sh1.Range("G" & i).Value Like "*" & sh2.Range("B2").Value & "*" Then

sh2.Cells(3, "C").Value = "CUSTOMER"

sh2.Cells(3, "D").Value = sh1.Range("B" & i).Offset(0, 5)

sh2.Cells(3, "H").Value = sh1.Range("B" & i).Offset(0, 1)

sh2.Range("A" & k).Value = sh1.Range("J" & i).Value

sh2.Range("B" & k).Value = k – 4

sh2.Range("C" & k).Value = sh1.Range("C" & i).Offset(0, 6)

sh2.Range("D" & k).Value = sh1.Range("O" & i).Value

sh2.Range("E" & k).Value = sh1.Range("P" & i).Value

sh2.Range("F" & k).Value = sh1.Range("Q" & i).Value

sh2.Range("G" & k).Value = sh1.Range("R" & i).Value

sh2.Range("H" & k).Value = sh1.Range("T" & i).Value

sh2.Range("I" & k).Value = sh1.Range("U" & i).Value

sh2.Range("J" & k).Value = sh2.Range("G" & k).Value * sh2.Range("I" & k).Value

sh2.Range("K" & k).Value = sh1.Range("W" & i).Value

sh2.Range("L" & k).Value = sh1.Range("AA" & i).Value

sh2.Range("M" & k).Value = sh1.Range("AB" & i).Value

sh2.Range("N" & k).Value = sh1.Range("AC" & i).Value

k = k + 1

End If

Next

'外部用循环，内部用判断语句，找到后赋值。

If sh2.Range("B5").Value = "" Then

sh2.Range("C5").Value = "Nothing was found!"

Exit Sub

End If

'提示信息

irow2 = sh2.Range("A65536").End(xlUp).Row

sh2.Range("B" & irow2 + 1).Value = "合计"

sh2.Range("C" & irow2 + 1).Value = "Total"

sh2.Range("C" & irow2 + 1 & ":O" & irow2 + 1).Borders(xlBottom).LineStyle = xlContinuous

sh2.Range("D" & irow2 + 1).Value = Application.WorksheetFunction.Sum(Range("D5:D" & irow2 + 1).Value)

sh2.Range("E" & irow2 + 1).Value = Application.WorksheetFunction.Sum(Range("E5:E" & irow2 + 1).Value)

sh2.Range("F" & irow2 + 1).Value = Application.WorksheetFunction.Sum(Range("F5:F" & irow2 + 1).Value)

sh2.Range("G" & irow2 + 1).Value = Application.WorksheetFunction.Sum(Range("G5:G" & irow2 + 1).Value)

sh2.Range("J" & irow2 + 1).Value = Application.WorksheetFunction.Sum(Range("J5:J" & irow2 + 1).Value)

sh2.Range("K" & irow2 + 1).Value = Application.WorksheetFunction.Sum(Range("K5:K" & irow2 + 1).Value)

sh2.Range("L" & irow2 + 1).Value = Application.WorksheetFunction.Sum(Range("L5:L" & irow2 + 1).Value)

sh2.Range("M" & irow2 + 1).Value = Application.WorksheetFunction.Sum(Range("M5:M" & irow2 + 1).Value)

sh2.Range("N" & irow2 + 1).Value = Application.WorksheetFunction.Sum(Range("N5:N" & irow2 + 1).Value)

sh2.Range("C" & irow2 + 3).Value = "2020-2021年度现金明细"

sh2.Range("C" & irow2 + 3 & ":N" & irow2 + 3).Merge

sh2.Range("C" & irow2 + 3 & ":N" & irow2 + 3).HorizontalAlignment = xlCenter

sh2.Range("C" & irow2 + 3 & ":O" & irow2 + 3).Borders(xlBottom).LineStyle = xlContinuous

sh2.Range("C" & irow2 + 4 & ":F" & irow2 + 4).Value = Array("项目名称", "第一笔", "第二笔", "第三笔")

sh2.Range("C" & irow2 + 4 & ":O" & irow2 + 4).Borders(xlBottom).LineStyle = xlContinuous

sh2.Range("N" & irow2 + 4).Value = "合计"

'求和计算

arr = sh1.Range("a1").CurrentRegion

j = 3

For i = 2 To irow

If sh1.Range("C" & i).Value Like "*" & sh2.Range("B2").Value And sh1.Range("X" & i).Value <> "" Then

j = j + 1

sh2.Cells(irow2 + 5, j) = arr(i, 24)

End If

Next i

sh2.Range("C" & irow2 + 5).Value = "预收款"

'预收款计算

For i = 2 To irow

If sh1.Range("C" & i).Value Like "*" & sh2.Range("B2").Value & "*" Or sh1.Range("G" & i).Value Like "*" & sh2.Range("B2").Value & "*" Then

sh2.Range("N" & irow2 + 5).Value = sh2.Range("N" & irow2 + 5).Value + sh1.Range("X" & i).Value

End If

Next i

sh2.Range("C" & irow2 + 6).Value = "应收款"

sh2.Range("N" & irow2 + 6).Value = sh2.Range("J" & irow2 + 1).Value – sh2.Range("K" & irow2 + 1).Value + sh2.Range("L" & irow2 + 1).Value – sh2.Range("M" & irow2 + 1).Value – sh2.Range("N" & irow2 + 1).Value

sh2.Range("C" & irow2 + 7).Value = "账户余额"

sh2.Range("N" & irow2 + 7).Value = sh2.Range("N" & irow2 + 5).Value – sh2.Range("N" & irow2 + 6).Value

sh2.Range("C" & irow2 + 7 & ":O" & irow2 + 7).Borders(xlBottom).LineStyle = xlContinuous

'应收款计算

Call 打印区域设置

'调用打印区域设置模块

Set sh1 = Nothing

Set sh2 = Nothing

'释放内存

Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic

'打开屏幕更新和自动计算

End Sub

2、其他模块（私信）

关于代码的解读

为了便于大家阅读代码的关键部分用空行进行了分割，并且必要的时候在下面用注释对代码进行了说明。请对照成品出库表和对账单工作表阅读，只要会Excel就一定能够读懂它。

最后，如有不妥或不明白之处，可在下方评论区留言评论，同时欢迎大家点赞、收藏、转发、评论。