VBA入库单模板
教你轻松制作仓库入库单自动登记系统.doc
教你轻松制作仓库入库单自动登记系统对于仓库工作人员来讲，每天会对大量的物料进行入库、出库的登记操作。
今天我们就来教大家如何运用VBA 代码，制作一个非常简便的仓库入库单系统。
【效果图】看了上面的动态效果，是不是感觉这个入库单非常神奇的呀。
我们只要点击开单，就可以重新更新表格，点击计算可以计算金额，点击保存可以保存我们输入的数据。
下面我们就来讲一下如何制作这个仓库入库。
第一步：如上图。
填写基础数据，将入库单页面的编号，品名等用数据有效性的方式进行引用，这样我们就可以实现轻松的对输入数据进行选择。
这样可以尽可能的缩短我们填写数据的时间。
第二步：编写VBA代码，实现计算、保存、开单等常用功能。
按快捷键alt+F11快速进入VBA代码编辑窗口，如上图。
输入下方代码。
Sub 开单()Set es = Cells.Find(*, , xlFormulas, , , xlPrevious)[b2] = SM Format(Now(), ymdhms)Range([a5], es.Offset(4)) =[e2] =End SubSub 保存()On Error GoTo 100Dim es As Range, a%If Sheet2.[f:f].Find([b2]) = [b2] ThenMsgBox 已经保存过了!Else100:Set es = Cells.Find(*, , xlFormulas, , , xlPrevious)a = Application.CountA(Sheet2.[a:a])If es.Row = 4 Then MsgBox 没有填写内容: EndRange([a5], es).Copy Sheet2.Cells(a + 1, 1)Sheet2.Cells(a + 1, f).Resize(es.Row - 4) = [b2] 保存入库单Sheet2.Cells(a + 1, g).Resize(es.Row - 4) = [e2] 保存供应商Sheet2.Cells(a + 1, h).Resize(es.Row - 4) = Now() 保存日期时间MsgBox 保存成功!End IfEnd SubSub 计算()Set es = Columns(3).Find(*, , xlFormulas, , , xlPrevious)For Each Rng In Range([c5], es)Rng.Offset(0, 2) = Rng.Offset(0, 1) * RngNextEnd Sub第三步：插入按钮插件，指定宏功能即可，如下图：现在你学会如何制作这个仓库入库单了吗？。
ic_general_b（出入库单表体）
bonroadflag
是否在途
breturnprofit
是否返利
bsafeprice
是否价保
bsourcelargess
上游是否赠品行
bsupplyflag
自动补货标志
btoinzgflag
调拨入库暂估标志
btoouttoiaflag
调拨出库传 IA 标志
btooutzgflag
调拨出库暂估标志
btou8rm
表体行状态
smallint
是
68
fchecked
待检标志
smallint
是
69
flargess
是否赠品
char
是
70
ftoouttransflag
调拨出库传 IA 时机
char
是
71
hsl
换算率
decimal
是
72
idesatype
拆解类型
integer
是
73
isok
结算完毕标志
char
是
74
naccumtonum
转出辅数量
decimal
是
115
ntranoutnum
转出数量
decimal
是
116
pk_bodycalbody
库存组织
char
是
117
pk_corp
公司
char
是
118
pk_creqwareid
需求仓库
char
是
119
pk_cubasdoc
客商基本档案 ID
char
是
120
pk_defdoc1
入库单(表格模板、doc格式)
入库单（表格模板、doc 格式）CW KG/BD- 01入库单编号:类别:?摩托车?汽车?其他物资年月日金额品名规格型号单位数量单价备注百十万千百十元角分合计（金额大写）: 佰拾万仟佰拾元角分库管员: 交货人: 制单: 注:本单一式三联，第一联仓库记帐联，第二联材料成本会计记帐联，第三联返交货人作有关结算凭证或回执联。
CW- KG/BD—08库存商品月周转速度统计表库别:制表日期:年月日统计日期:年月日——年月日单位:次/期间（月）商品名称单位周转量日均库存量周转速度周转天数月周转复核:制表:注:本表一式九份，一份库管部留存，其余分报总经理、财务总监、营销总监、财务会计部经理、管理会计部经理、销售管理部经理、运城分公司经理、材料成本会计。
本备注适用于摩托车库存分析。
CV- KG/B DH 09滞件/ 滞车处理表类别: 滞件? 滞车? 年月日名称及规格型号数量单位金额存放地点入库日期合计滞存原因及状况质检结论及建议审计结论及建议拟处理方式估计损失批准财务核准财务审核库管部门负责人: 制表: 注: 本单如反映滞车情况，则一式三份，库管部留存一份，另两份分报销售管理部经理、财务会计部经理。
本单若反映滞件情况，则一式四份，配件库留存一份，另三份分报售后服务中心财会室主管、综合服务部经理、通用配件经销部经理。
CW- KG/BD- 03出库号码单年月日制单:客户品名架号机号客户品名架号机号CW- KG/BD—02入库号码单车型: 年月日制单:架号机号架号机号架号机号CV- KG/B DH 04库存盘点表库别: 盘点时间: 盘点限时: 第页，共页品名规格型号单位帐面数量实盘数量盘盈亏备注品名规格型号单位帐面数量实盘数量盘盈亏备注财会会点人: 盘点人: 制表:注: 本表一式四份，一份仓库留存，其余分报财务总监、财务会计部经理、材料成本会计。
CW- KG/BD- 05产品库存日报厂家: 年月日制表: 品名及规格型号色别上日入库上日出库库存结余品名及规格型号色别上日入库上日出库库存结余注: 本表一式八份，一份库管部留存，其余分报营销总监、销售管理部经理、销售管理部内勤、运城分公司经理、运城分公司内勤、零售部经理、零售部内勤。
通用Excel库存管理系统
通用Excel库存管理系统，最好用的Excel出入库管理表格库管易网站的表格版块有很多实用出入库管理表格，得到广大仓库管理同行的支持，经过分析与提取各个表格中的实用功能，专门制作了本套《通用Excel库存管理系统》表格。
包含仓库货物做账用到的入库、出库、汇总、报表等全部功能，适合绝大部分的仓库、商铺、网店的出入库管理。
使用前提：本表格使用VBA编程完成出入库的自动化处理，在使用前，请在Excel软件中启用宏，具体的方法可以参考Excel启用宏的方法这篇贴子，正确启用宏功能以后，关闭Excel软件，重新打开表格就可以正常使用了。
本贴子简要介绍Excel库存管理系统，让大家可以快速了解各个功能模板的使用方法，强烈建议您阅读本贴的使用教程，然后再开始使用Excel库存管理系统，这样可以少走很多弯路。
一、系统登录与主界面1、打开库存管理系统，首先看到的是登录界面，要求登录才可以进入系统管理。
系统内置了一个管理员账号：admin，初始密码：123。
在登陆界面点击'修改密码”可以改为您自己想用的密码。
如果想增加账号，请登陆系统后，在主界面中点击'用户申请〃，在弹出窗口中填写好用户名、密码等资料后确认就可以了。
2、成功登录库存管理系统，首先显示操作主界面，这里列出了所有的功能模块。
主界面“功能导航”区域共有12个按钮，对应着不同的管理功能，点击按钮就可以进入相应的功能界面进行操作。
二、货物信息与基础资料在开始做账前，需要完善货物信息与基础资料，在主界面点击'系统设置”按钮，进入设置工作表，界面分为左右两部分。
1、左面是货物（商品）的列表，里面已经输入了一些示例货物信息（1）编号：就是货物编码，就像人的身份证一样，编号是货物的唯一标识，每个货物必须有一个编号并且不能重复。
在制定编号时也可以根据企业的编码规则制定，也可以像示例数据那样直接使用顺序编号。
（2）货物名称、规格型号、单位、库别（分类）：请根据实际情况填写。
财务表格产品入库单
CK-KG/BD---01产品入库单编号：年月日入库人：复核人：库管员：注：一式三联。
一联成品库存根，一联交生产部，一联交财务核算部。
CK-KG/BD---07CK-KG/BD---08收货单库管员：采购员：送货人：注一：备注栏填写说明：1、如果送货人有送货单则注明，不再向送货人发送本单。
2、如果是收销售环节退、换货则注明。
3、如果是自提货需要先开收货单再注明。
注二：本单一式两联，仓库留存一联，另一联返送货单位。
入库单编号：年月日采购员：库管员：注：本单一式两联，第一联为仓库计账联，第二联交采购员办理付款并作为财务计帐联。
本单适用于成品以外的物品入库。
领料单材料类别：年月日库管员：领料部门负责人：领料人：一联生产部门留存，一联交财务核算部记帐，一联交库管部登记台帐滞料/滞成品处理审批表类别：滞料□滞成品□年月日批准人：库管员：注：本单一式两份，仓库留存一份，报会计部一份。
财产登记卡使用部门：年月日监督使用部门：审批人：责任签字：财产登记卡由领用人填写，一联交本部门财产登记专人，一联交财务管理部保管。
物品领用单领用部门：年月日领用部门经理：批准人：领用人：库管员：注：本单一式三联，一联仓库存根，一联报财务核算部，一联领用部门存查。
此单为通用单，适用于领用除原材料以外的物品。
产品出库单编号：年月日提货人：库管员：注：本单一式两联，第一联仓库存根，第二联交营业部。
灭菌产品送、返登记表CK-KG/BD---09库存日报表废品损失的核算与计算废品损失是指不可修复废品的生产成本扣除废品残值与应由过失人负担赔款后的净损失与可修复废品的修复费用之与。
出售后发现的废品，由于退回废品而支付的运杂费也应包括在废品损失之内。
（1）实行三包（包修、包换、包退）的企业，发生销售退回的“三包”损失，包括修理费、退修或调换产品的运杂费，退回报废产品的实际成本减去残值后的净损失等，可列入企业的管理费用，不作为废品损失处理。
（2）对于产品质量较差，但经检验部门鉴定，不需要返修即可降级出售或使用的产品，应作为次品处理，其损失在销售中体现，不包括在废品损失之内。
采购入库单 采购部表格模板
采 购 入 库 单
订单号： 入库单号： 供货单位： 存货编码 存货名称 入库日期： 入库类别： 备注： 数量 单价 仓管： 税率： 金额 重量T
第 二 联 回 单 联
单位
合 计
制单人： 审核人： 红色：顾客联 记帐人： 黄色：记帐联 白色：存根联 蓝色：回单联 华兴表格：HX/RP-H-023 B/0
采 购 入 库 单
订单号： 入库单号： 供货单位： 存货编码 存货名称 单位 入库日期： 入库类别： 备注： 数量 单价 仓管： 税率：
金额
重量T
第 一 联 存 根 联
合 计ቤተ መጻሕፍቲ ባይዱ
制单人： 审核人： 白色：存根联 蓝色：回单联 华兴表格：HX/RP-H-023 B/0 记帐人： 红色：顾客联 黄色：记帐联
ExcelVBA7.47将总表的数据分别按照要求填入指定的模板位置中，类似word邮件合并功能
ExcelVBA7.47将总表的数据分别按照要求填入指定的模板位置中，类似word邮件合并功能一起学习，一起进步~~word的邮件合并功能，相信大家都非常的熟悉了，一些固定模板的批量打印功能都会用到这样的操作，但是很多时候我们的数据是Excel中的，那么我们是否能够在Excel中实现类似于word中这种数据b合并的功能呢？代码区其实这样的话，就有点类似于我们之前学过的Excel的数据汇总的逆推，数据的拆分了，按照计划，我们很快就会接触到更多类型的数据的拆分了，我们这里就先热个场，提前接触下数据的拆分，之所以在这里说数据拆分，主要还是因为他的操作也类似于在多个工作表中同时进行数据填充，和我们之前的章节又有一点关系，所以正好有承上启下的作用来看看我们的场景现在我们手上的这个工作表里面有两个表，一个就是成绩总表，一个就是模板，类似于我们通知的模板，我们现在需要将总成绩的表中所有的同学的成绩按照模板中指定的样式进行填充，并且形成一个人一个工作表的样式来进行打印，并交给学生查看。
如果手动复制粘贴，这个工作量就非常的大了，因为不仅仅是复制粘贴，还要找到正确的位置，所以这里我们需要使用VBA来帮助我们实现这样的功能。
Sub sssss()••••••••••••••••••Dim rng As Range, sth As Worksheet, sthn As Worksheet Set rng = Application.InputBox("请选择数据源,不含表头", "数据源的确定", , , , , , 8)For i = 1To rng.Rows.Count arr = rng.Rows(i) Worksheets("模板").Copy after:=Worksheets(Worksheets.Count) = arr(1, 1) Set sthn = ActiveSheet sthn.Cells(4, 3) = arr(1, 1) sthn.Cells(4, 5) = arr(1, 2) sthn.Cells(6, 4) = i sthn.Cells(8, 4) = arr(1, 3) sthn.Cells(9, 4) = arr(1, 4) sthn.Cells(10, 4) = arr(1, 5) sthn.Cells(11, 4) = arr(1, 6) sthn.Cells(12, 4) = arr(1, 7) sthn.Cells(13, 4) = arr(1, 8)Next i End Sub看着代码挺长，请示非常的简单，中间一大段都是理解之后就非常的简单了。
入库出库表格模板
入库
来源：供应商X
XX
退货
商品J
J型
品牌X
10
20XX-01-14
出库
去向：客户S
XX
特价
说明：
商品信息：包括商品名称、型号、品牌等。
数量：入库或出库的商品数量。
日期：商品入库或出库的具体日期。
来源/去向：入库商品的来源或出库商品的去向。
负责人：负责此次入库或出库的员工。
备注：任何额外的信息，比如商品的状态或特殊情况。
入库出库表格模板
商品名称
商品型号
品牌
数量
日期
方向
来源/去向
负责人
备注
商品A
A型
品牌X
50
20XX-01-05
入库
来源：供应商Z
XX
-
商品B
B型
品牌Y
30
20XX-01-06
出库
去向：客户W
XX
加急
商品C
C型
品牌Z
20
20XX-01-07
入库
来源：供应商X
XX
损坏更换
商品D
D型
品牌X
10
20XX-01-08
出库
去向：客户V
XX
-
商品E
E型
品牌Y
40
20XX-01-09
入库
来源：供应商Y
XX
正常
商品F
F型
品牌ZBiblioteka 2520XX-01-10出库
去向：客户U
XX
延迟
商品G
G型
品牌X
35
20XX-01-11
入库
入库单模板
入库单
编号：
类别：□摩托车□汽车□其他物资年月
库管员：交货人：制单：
注：本单一式三联，第一联仓库记帐联，第二联材料成本会计记帐联，第三联返交货人作有关结算凭证或回执联。
入库单
编号：
类别：□摩托车□汽车□其他物资年月日
库管员：交货人：制单：
注：本单一式三联，第一联仓库记帐联，第二联材料成本会计记帐联，第三联返交货人作有关结算凭证或回执联。
入库单
编号：
类别：□摩托车□汽车□其他物资年月
库管员：交货人：制单：
注：本单一式三联，第一联仓库记帐联，第二联材料成本会计记帐联，第三联返交货人作有关结算凭证或回执联。
入库单模板模板
入库单模板一、基本信息1. 入库单编号：____________________2. 入库日期：____________________年____月____日3. 供应商名称：____________________4. 采购订单编号：____________________5. 验收人：____________________二、商品信息序号 | 商品名称 | 商品型号 | 商品规格 | 单位 | 数量 | 单价（元） | 总价（元） | 备注||||||||三、入库单填写说明1. 入库单编号：由仓库管理员按照入库单编制规则填写，确保唯一性。
2. 入库日期：填写实际商品入库的日期。
3. 供应商名称：填写提供商品的供应商全称。
4. 采购订单编号：填写对应的采购订单编号，以便于核对。
5. 验收人：填写负责验收商品的人员姓名。
四、商品信息填写说明1. 序号：按照实际商品顺序填写，从1开始依次递增。
2. 商品名称：填写商品的全称。
3. 商品型号：填写商品的型号，如有多个型号，请分别列出。
4. 商品规格：填写商品的规格，如有多个规格，请分别列出。
5. 单位：填写商品计量的单位，如件、台、箱等。
6. 数量：填写实际入库商品的数量。
7. 单价（元）：填写商品的单价，精确到小数点后两位。
8. 总价（元）：填写商品的总价，精确到小数点后两位，计算公式为：数量×单价。
五、入库单提交与审核流程1. 仓库管理员根据实际入库情况填写入库单。
2. 验收人对照采购订单及实际到货商品进行验收，确认无误后在入库单上签字。
3. 仓库管理员将填写完整、验收合格的入库单提交至财务部门。
4. 财务部门对入库单进行审核，审核通过后，入库单正式生效。
六、注意事项1. 入库单填写内容必须真实、准确、完整，如有虚假，相关责任人需承担相应法律责任。
2. 入库单为仓库管理的重要凭证，请妥善保管。
如有遗失，请及时与仓库管理员联系。
3. 如有商品数量、型号、规格等与采购订单不符，请及时与采购部门沟通，核实原因。
工厂Excel出入库管理系统-适合工厂使用的仓库台账表格
工厂Excel出入库管理系统，适合工厂使用的仓库台账表格做为仓库管理人员，有一款好用的出入库管理系统，那么仓库做账将会更加方便、快捷、准确，特别是生产企业，对于供应商送货、生产部门领料等，货物出入仓库很频繁，如果手工记录，工作量将会很大，有了这款工厂Excel出入库管理系统，相当于有了功能强大又顺手的自动化工具。
最近在仓库管理QQ群里，很多仓储管理同行提到，需要适合工厂使用的仓库台账表格，他们对表格功能要求不复杂，主要是用于记录货物出入库、自动计算库存、进出库信息查询等，特别提到的，大部分工厂仓库做账，都不记录单价、金额，而只是记录货物数量。
当然，如果您的企业不是工厂，但是做账的要求与此类似，也适合使用这款Excel出入库管理系统。
最近抽时间做了这款工厂Excel出入库管理系统，用了两个星期时间开发，完全使用VBA编程，运行效率高、数据保存安全，这套Excel出入库管理系统最大的特点就是在出入库时只货物货物数量不记录价格，现在正式发布分享给大家使用。
一、工厂出入库表格主界面主界面清爽简洁，总共六个功能按钮：入库单、入库明细、出库单、出库明细、库存汇总、基础资料。
各位同行一看导航面板，应该对各模块功能大概了解。
特别提示：Excel 仓库台账表格使用VBA与宏制作，使用前请按Excel启用宏的方法这篇贴子对Excel设置一下，然后就可以正使用了。
二、仓库基础资料设置在主界面点击“基础资料”按钮，可以看到基础资料工作表。
基础资料其分为三个区域：商品信息、送货单位、领料部门，已经使用不同的颜色填充。
其中商品信息里包括：物料编号、物料名称、规格型号、期初库存，期初库存就是开始使用Excel仓库台账表格时物料的当前库存数量，如果没有期初库存可以设为“0”。
送货单位、领料部门这两个区域不是必填项，如果在物料出入库时不需要这两个信息，可以不用设置。
三、物料入库单与出库单操作在主界面点击“入库单”或者“出库单”按钮，就可以开始进行相应的出入库操作，因为这两个功能非常类似，下面就以“入库单”的操作方法做为例子演示：1、新建单据：要开始一张新的入库单，点击“新建”按钮，此时会自动清空物料列表、日期默认设为当前（可以修改），单据号自动生产。
VBA代码全集模板
目录一、引用 (3)二、Worksheet_Change事件： (3)三、相乘 (5)四、相减 (6)五、高级筛选 (6)六、双击事件 (8)七．单位汇总（sumif），单条件汇总 (10)八、多条件汇总（连接、sumif） (13)九、多条件汇总、ado (15)十、对账 (16)十一、sql筛选 (20)十二、sql连接、交叉汇总 (21)十三、select语句总结 (23)十四、报表（有层次） (24)一、引用相对引用B4绝对引用$B$4混合引用$B4、B$4F4进行引用切换，$在字母前面则锁定列，在数字前面则锁定行。
二、Worksheet_Change 事件：1.在单元格中C4=VLOOKUP(B4,简码表!$B$4:$C$1000,2,FALSE)2. Worksheet_Change事件代码：Private Sub Worksheet_Change(ByVal Target As Range)On error resume nextIf Target.Row > 3 And Target.Column = 2 Theni = Target.RowCells(i, 3) = Application.WorksheetFunction.VLookup(Cells(i, 2), Sheets("简码表").Range("b4:c100"), 2, False)End IfEnd Sub备查代码：Private Sub Worksheet_Change(ByVal Target As Range)On Error Resume NextIf Target.Row > 3 And Target.Column = 5 Theni = Target.RowCells(i, 6) = Application.WorksheetFunction.VLookup(Cells(i, 5), Sheets("类款项").Range("b2:e2000"), 2, False)Cells(i, 7) = Application.WorksheetFunction.VLookup(Cells(i, 5), Sheets("类款项").Range("b2:e2000"), 3,False)Cells(i, 8) = Application.WorksheetFunction.VLookup(Cells(i, 5), Sheets("类款项").Range("b2:e2000"), 4, False)End IfEnd Sub三、相乘Sub 计算金额()Application.ScreenUpdating = FalseDim i As LongDim irow As Longirow = Range("a3").End(xldown).RowFor i = 4 To irowCells(i, 3) = Cells(i, 1) * Cells(i, 2)Next iApplication.ScreenUpdating = TrueEnd Sub四、相减Sub 相减()Application.ScreenUpdating = FalseRange("c3:c10000").ClearContentsDim i As LongDim irow As Longirow = Range("a5000").End(xlUp).RowFor i = 3 To irowCells(i, 3) = VBA.Round((Cells(i, 1) - Cells(i, 2)), 2)Next iApplication.ScreenUpdating = TrueEnd Sub五、高级筛选（工具-宏-录制新宏，宏名改成高级筛选）Sub 高级筛选()Sheets("业务").Range("A3:I10000").AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=ActiveCell.Range("A1:B1"), Unique:=TrueEnd Sub六、双击事件1.插入-名称-定义（修改名称和引用位置）2．查看代码-插入-用户窗体工具箱-多页、列表框-右键属性点击page1修改caption为资产类-点击空白列表框修改rowsource 为box1依次类推3. 业务表-查看代码 Worksheet beforedoubleclickPrivate Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Row > 3 And Target.Column = 6 ThenUserForm1.ShowSheets("初始化").Range("m3") = ActiveCellElseIf Target.Row > 3 And Target.Column = 7 ThenUserForm2.ShowEnd IfEnd Sub备查代码：Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Row > 3 And Target.Column = 6 ThenUserForm1.ShowSheets("初始化").Range("c2") = ActiveCellElseIf Target.Row > 3 And Target.Column = 7 ThenUserForm2.ShowSheets("初始化").Range("f2") = ActiveCellElseIf Target.Row > 3 And Target.Column = 8 ThenUserForm3.ShowEnd IfEnd Sub4．右键点击Userform1查看代码 Listbox1 dbclickPrivate Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox1.ListIndex, 0)Unload MeEnd SubPrivate Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox2.ListIndex, 0)Unload MeEnd SubPrivate Sub ListBox3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox3.ListIndex, 0)Unload MeEnd SubPrivate Sub ListBox4_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox4.ListIndex, 0)Unload MeEnd SubPrivate Sub ListBox5_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox5.ListIndex, 0)Unload MeEnd Sub见上图5.插入用户窗体右键点击userform2 worksheet dblclickPrivate Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 7) = ListBox1.List(ListBox1.ListIndex, 0)Unload MeEnd SubUserform initializePrivate Sub UserForm_Initialize()Application.ScreenUpdating = FalseWith Sheets("初始化")Sheets("科目表").Range("h2:i10000").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=.Range("m2:m3"), CopyToRange:=.Range("n2"), Unique:=TrueEnd WithApplication.ScreenUpdating = TrueEnd Sub七．单位汇总（sumif），单条件汇总=SUMIF(业务!$D$4:$D$1000,单位汇总!$A15,业务!I$4:I$10000)Sub 单位汇总1()Application.ScreenUpdating = Falserange("a1:i10000").ClearCells(3, 2) = "指标数"Cells(3, 3) = "拨款数"Cells(3, 4) = "余额"Cells(1, 7) = "单位"Cells(3, 7) = "单位"Cells(3, 8) = "指标数"Cells(3, 9) = "拨款数"Sheets("业务").Range("D3:D10000").AdvancedFilter Action:=xlFilterCopy, _CopyToRange:=Range("A3"), Unique:=TrueSheets("业务").Range("A3:J10000").AdvancedFilter Action:=xlFilterCopy, _CriteriaRange:=Range("G1:G2"), CopyToRange:=Range("G3:I3"), Unique:=FalseDim i As LongDim irow As Longirow = Range("a3").End(xlDown).RowFor i = 4 To irowCells(i, 2) = Application.WorksheetFunction.SumIf(Range("g4:g10000"), Cells(i, 1), Range("h4:h10000"))Cells(i, 3) = Application.WorksheetFunction.SumIf(Range("g4:g10000"), Cells(i, 1), Range("i4:i10000"))Cells(i, 4) = VBA.Round(Cells(i, 2) - Cells(i, 3), 2)Next iRange("g1:i10000").ClearApplication.ScreenUpdating = TrueEnd Sub八、多条件汇总（连接、sumif）连接=k4&l4&m4&n4Vba：Sub 多条件汇总()Application.ScreenUpdating = FalseRange("a1:p10000").ClearSheets("业务").Range("D3:G10000").AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=Range("B3:E3"), Unique:=TrueSheets("业务").Range("D3:I10000").AdvancedFilter Action:=xlFilterCopy, _CopyToRange:=Range("K3:P3"), Unique:=FalseDim j As LongDim jrow As Longjrow = Range("k3").End(xlDown).RowFor j = 4 To jrowCells(j, 10) = Cells(j, 11) & Cells(j, 12) & Cells(j, 13) & Cells(j, 14)Next jDim i As LongDim irow As Longirow = Range("b3").End(xlDown).RowFor i = 4 To irowCells(3, 6) = "指标数"Cells(3, 7) = "拨款数"Cells(3, 8) = "余额"Cells(i, 1) = Cells(i, 2) & Cells(i, 3) & Cells(i, 4) & Cells(i, 5)Cells(i, 6) = Application.WorksheetFunction.SumIf(Range("j4:j10000"), Cells(i, 1), Range("o4:o10000"))Cells(i, 7) = Application.WorksheetFunction.SumIf(Range("j4:j10000"), Cells(i, 1), Range("p4:p10000"))Cells(i, 8) = VBA.Round(Cells(i, 6) - Cells(i, 7), 2)Next iRange("i3:p10000").ClearRange("a1:a10000").DeleteApplication.ScreenUpdating = TrueEnd Sub九、多条件汇总、adoSub 多条件汇总()Application.ScreenUpdating = FalseDim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 单位,类,款,项, sum(指标数) as 预算股指标,sum(拨款数) as 预算股拨款 from[业务$a3:J10000] where 归口='" & Range("h2").Value & "'and 月<=" & Range("i2").Value & " GROUP BY 单位,类,款,项"rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("多条件汇总").Cells(3, i) = rst.Fields(i - 1).Name Next iSheets("多条件汇总").Range("a4").CopyFromRecordset rst rst.Closecnn.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = TrueEnd Sub十、对账Sub 预算股()Application.ScreenUpdating = FalseDim i As IntegerDim strsql1 As StringDim cnn1 As New ADODB.ConnectionDim rst1 As New ADODB.Recordsetcnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql1 = " SELECT 单位,类,款,项, sum(指标数) as 预算股指标 from[预算股$a3:m50000] where 归口='" & Range("h2").Value & "'and 月<=" & Range("i2").Value & " GROUP BY 单位,类,款,项" rst1.Open strsql1, cnn1For i = 1 To rst1.Fields.CountSheets("对帐").Cells(3, i + 10) = rst1.Fields(i - 1).NameNext iSheets("对帐").Range("k4").CopyFromRecordset rst1rst1.Closecnn1.CloseSet rst1 = NothingSet cnn1 = NothingDim strsql2 As StringDim cnn2 As New ADODB.ConnectionDim rst2 As New ADODB.Recordsetcnn2.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql2 = " SELECT 单位,类,款,项, sum(指标数) as 专业股指标 from[专业股$a3:j50000] where 归口='" & Range("h2").Value & "'and 月<=" & Range("i2").Value & " GROUP BY 单位,类,款,项" rst2.Open strsql2, cnn2For i = 1 To rst2.Fields.CountSheets("对帐").Cells(3, i + 19) = rst2.Fields(i - 1).NameNext iSheets("对帐").Range("t4").CopyFromRecordset rst2rst2.Closecnn2.CloseSet rst2 = NothingSet cnn2 = Nothings = Application.WorksheetFunction.CountA(Range("k4:k10000")) + 4Range("T4:W10000").SelectSelection.CopyRange("K" & s).SelectActiveSheet.PasteRange("X4:X10000").SelectSelection.CopyRange("P" & s).SelectActiveSheet.PasteRange("X3").SelectSelection.CopyRange("P3").SelectActiveSheet.PasteDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 单位,类,款,项, sum(预算股指标) as 预算股指标 ,sum(专业股指标) as 专业股指标 from[对帐$k3:p50000] GROUP BY 单位,类,款,项"rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("对帐").Cells(3, i) = rst.Fields(i - 1).NameNext iSheets("对帐").Range("a4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = TrueEnd Sub十一、sql筛选Sub 筛选()Application.ScreenUpdating = FalseDim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT distinct 单位,类,款,项 from[专业$a3:h10000]"rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("筛选").Cells(3, i) = rst.Fields(i - 1).NameNext iSheets("筛选").Range("a4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = True End Sub十二、sql连接、交叉汇总Sub 连接()Application.ScreenUpdating = FalseDim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 股,月,归口,单位,类,款,项,指标数 from [专业$a3:h10000] union ALL SELECT 股,月,归口,单位,类,款,项,指标数 from [预算$a3:l10000] order by 股 desc"rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("连接").Cells(1, i + 19) = rst.Fields(i - 1).NameNext iSheets("连接").Range("t2").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = TrueEnd SubSub 汇总()Application.ScreenUpdating = FalseCall 连接Dim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " transform sum(指标数) SELECT 单位,类,款,项 from [连接$t1:aa10000] where 归口= '" & Range("h2").Value & "' and 月=" & Range("i2").Value & " group by 单位,类,款,项 pivot 股" rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("连接").Cells(3, i) = rst.Fields(i - 1).NameNext iSheets("连接").Range("a4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingRange("t1:aa10000").ClearContentsApplication.ScreenUpdating = TrueEnd Sub十三、select语句总结1、筛选（false ---筛选全部）Select 列表名称1,列表名称2,…….列表名称n from [表$区域]或者Select * from [表$区域]2、筛选唯一的数据Select distinct 列表名称1,列表名称2,…….列表名称n from [表$区域]3、分类汇总Select 列表名称1,列表名称2,…….列表名称n，sum(a) as a from [表$区域]Group by列表名称1,列表名称2,…….列表名称n4、条件分类汇总Select 列表名称1,列表名称2,…….列表名称n，sum(a) as a from [表$区域]Where 归口=’”& range(“”).value &”’ and 月=”& range(“”).value &” Group by列表名称1,列表名称2,…….列表名称n5、交叉汇总Transform sum() select 列名称1,……列名称n from[表$区域] group by 列名称1，…..列名称n pivot 交叉事项6、连接Select 列名称1，…列名称n from[表$区域] union all Select 列名称1，…列名称n from[表$区域] order by 列名称 desc十四、报表（有层次）连接Transform sum（指标数），pivot 股按单位、类、款进行汇总按单位、类进行汇总按单位进行汇总连接以上四个表的内容，并按单位、类、款、项进行排序，其中单位按降序排序1、整体写代码Sub 报表()Application.ScreenUpdating = FalseDim i As IntegerDim strsql1 As StringDim cnn1 As New ADODB.ConnectionDim rst1 As New ADODB.Recordsetcnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql1 = " SELECT 股,月,归口,单位,类,款,项,sum(指标数) as 指标数 from[专业$a3:h10000] group by 股,月,归口,单位,类,款,项 union all SELECT 股,月,归口,单位,类,款,项,sum(指标数) as 指标数 from[预算$a3:l10000] group by 股,月,归口,单位,类,款,项 order by 股 desc"rst1.Open strsql1, cnn1For i = 1 To rst1.Fields.CountSheets("报表").Cells(3, i + 9) = rst1.Fields(i - 1).NameNext iSheets("报表").Range("j4").CopyFromRecordset rst1rst1.Closecnn1.CloseSet rst1 = NothingSet cnn1 = NothingDim strsql2 As StringDim cnn2 As New ADODB.ConnectionDim rst2 As New ADODB.Recordsetcnn2.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql2 = "transform sum(指标数) SELECT 单位,类,款,项 from[报表$j3:q10000] where 归口='" & Range("g2") _.Value & "' and 月<=" & Range("h2").Value & " group by 单位,类,款,项 order by 单位 desc pivot 股 "rst2.Open strsql2, cnn2For i = 1 To rst2.Fields.CountSheets("报表").Cells(3, i + 19) = rst2.Fields(i - 1).NameNext iSheets("报表").Range("t4").CopyFromRecordset rst2rst2.Closecnn2.CloseSet rst2 = NothingSet cnn2 = NothingDim strsql3 As StringDim cnn3 As New ADODB.ConnectionDim rst3 As New ADODB.Recordsetcnn3.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql3 = "SELECT 单位,类,款,sum(专业股) as 专业股,sum(预算股) as 预算股 from[报表$t3:y10000] group by 单位,类,款 order by 单位 desc"rst3.Open strsql3, cnn3For i = 1 To rst3.Fields.CountSheets("报表").Cells(3, i + 26) = rst3.Fields(i - 1).NameNext iSheets("报表").Range("aa4").CopyFromRecordset rst3rst3.Closecnn3.CloseSet rst3 = NothingSet cnn3 = NothingDim strsql4 As StringDim cnn4 As New ADODB.ConnectionDim rst4 As New ADODB.Recordsetcnn4.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql4 = "SELECT 单位,类,sum(专业股) as 专业股,sum(预算股) as 预算股 from[报表$t3:y10000] group by 单位,类 order by 单位 desc"rst4.Open strsql4, cnn4For i = 1 To rst4.Fields.CountSheets("报表").Cells(3, i + 32) = rst4.Fields(i - 1).NameNext iSheets("报表").Range("ag4").CopyFromRecordset rst4rst4.Closecnn4.CloseSet rst4 = NothingSet cnn4 = NothingDim strsql5 As StringDim cnn5 As New ADODB.ConnectionDim rst5 As New ADODB.Recordsetcnn5.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql5 = "SELECT 单位,sum(专业股) as 专业股,sum(预算股) as 预算股 from[报表$t3:y10000] group by 单位 order by 单位 desc"rst5.Open strsql5, cnn5For i = 1 To rst5.Fields.CountSheets("报表").Cells(3, i + 37) = rst5.Fields(i - 1).NameNext iSheets("报表").Range("al4").CopyFromRecordset rst5rst5.Closecnn5.CloseSet rst5 = NothingSet cnn5 = NothingColumns("AD:AD").SelectSelection.Insert Shift:=xlToRightRange("ad3") = "项"Columns("Aj:Ak").SelectSelection.Insert Shift:=xlToRightRange("aj3") = "款"Range("ak3") = "项"Columns("Ap:Ar").SelectSelection.Insert Shift:=xlToRightRange("ap3") = "类"Range("aq3") = "款"Range("ar3") = "项"Dim strsql6 As StringDim cnn6 As New ADODB.ConnectionDim rst6 As New ADODB.Recordsetcnn6.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql6 = " SELECT 单位,类,款,项,专业股,预算股 from [报表$t3:y10000] union all SELECT 单位,类,款,项,专业股,预算股 from [报表$aa3:af10000] union all SELECT 单位,类,款,项,专业股,预算股 from [报表$ah3:am10000] union all SELECT 单位,类,款,项,专业股,预算股 from [报表$ao3:at10000] order by 单位 desc,类,款,项 "rst6.Open strsql6, cnn6For i = 1 To rst6.Fields.CountSheets("报表").Cells(3, i) = rst6.Fields(i - 1).NameNext iSheets("报表").Range("a4").CopyFromRecordset rst6rst6.Closecnn6.CloseSet rst6 = NothingSet cnn6 = NothingRange("j1:au10000").ClearContentsDim p As LongDim prow As Longprow = Range("a3").End(xlDown).RowFor p = 4 To prowRange("g3") = "金额"Cells(p, 7) = VBA.Round(Cells(p, 6) - Cells(p, 5), 2)Next pApplication.ScreenUpdating = TrueEnd Sub2、分开写代码：Sub 连接()Application.ScreenUpdating = FalseDim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 月,归口,股,单位,类,款,项,sum(指标数) as 指标数 from[专业$a3:h10000] group by 月,归口,股,单位,类,款,项 union all SELECT 月, 归口,股,单位,类,款,项,sum(指标数) as 指标数 from[预算$a3:l10000] group by 月, 归口,股,单位,类,款,项 order by 股 desc"rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("报表").Cells(3, i + 9) = rst.Fields(i - 1).NameNext iSheets("报表").Range("j4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = TrueEnd SubSub 项()Application.ScreenUpdating = FalseCall 连接Dim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';DataSource=" & ThisWorkbook.FullNamestrsql = "transform sum(指标数) SELECT 单位,类,款,项 from [报表$j3:q10000] where 归口= '" & Range("g2").Value & "' and 月<=" & Range("h2").Value & " group by 单位,类,款,项 pivot 股"rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("报表").Cells(3, i + 19) = rst.Fields(i - 1).NameNext iSheets("报表").Range("t4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = TrueEnd SubSub 款()Application.ScreenUpdating = FalseCall 项Dim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 单位,类,款, sum(专业股) as 专业股, sum(预算股) as 预算股 from [报表$t3:y10000] group by 单位,类,款 "rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("报表").Cells(3, i + 26) = rst.Fields(i - 1).NameNext iSheets("报表").Range("aa4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingColumns("AD:AD").SelectSelection.Insert Shift:=xlToRightCells(3, 30) = "项"Application.ScreenUpdating = TrueEnd SubSub 类()Application.ScreenUpdating = FalseCall 款Dim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 单位,类, sum(专业股) as 专业股, sum(预算股) as 预算股 from [报表$aa3:af10000] group by 单位,类 "rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("报表").Cells(3, i + 33) = rst.Fields(i - 1).NameNext iSheets("报表").Range("ah4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingColumns("AJ:AJ").SelectSelection.Insert Shift:=xlToRightColumns("AK:AK").SelectSelection.Insert Shift:=xlToRightRange("AJ3").SelectActiveCell.FormulaR1C1 = "款"Range("AK3").SelectActiveCell.FormulaR1C1 = "项"Application.ScreenUpdating = TrueEnd SubSub 单位()Application.ScreenUpdating = FalseCall 类Dim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 单位, sum(专业股) as 专业股, sum(预算股) as 预算股 from [报表$ah3:am10000] group by 单位 "rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("报表").Cells(3, i + 40) = rst.Fields(i - 1).NameNext iSheets("报表").Range("ao4").CopyFromRecordset rstrst.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = True Columns("AP:AP").SelectSelection.Insert Shift:=xlToRight Columns("AQ:AQ").SelectSelection.Insert Shift:=xlToRight Columns("AR:AR").SelectSelection.Insert Shift:=xlToRight Range("AP3").SelectActiveCell.FormulaR1C1 = "类"Range("AQ3").SelectActiveCell.FormulaR1C1 = "款"Range("AR3").SelectActiveCell.FormulaR1C1 = "项" End SubSub 报表()If Range("i2") = "类" ThenCall 类ElseIf Range("i2") = "款" ThenCall 款ElseCall 项End IfEnd SubSub 总报表()Application.ScreenUpdating = FalseDim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 单位,类,款,项,专业股,预算股 from [报表$t3:y10000] union all SELECT 单位,类,款,项,专业股,预算股 from [报表$aa3:af10000] union all SELECT 单位,类,款,项,专业股,预算股 from [报表$ah3:am10000] union all SELECT 单位,类,款,项,专业股,预算股 from [报表$ao3:at10000] order by 单位 desc,类,款,项 "rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("报表").Cells(3, i) = rst.Fields(i - 1).NameNext iSheets("报表").Range("a4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingRange("j1:br10000").ClearApplication.ScreenUpdating = TrueEnd Sub插入图片Sub 按钮48_单击() 宏按钮名，编码时自动生成On Error Resume NextDim MR As RangeFor Each MR In SelectionIf Not IsEmpty(MR) ThenMR.SelectML = MR.LeftMT = MR.TopMW = MR.WidthMH = MR.HeightActiveSheet.Shapes.AddShape(msoShapeRectangle, ML, MT, MW, MH).SelecterPicture _End IfNextEnd Sub与EXCEL表在同一个文件夹里，。
入库验收单表格模板
生产管理科仓库成品
入经主入主库
手记库人管管人
录
专业文档考试资料学习资料教育试题方案设计
--
日入库名称数量验收部门验收人员管入库人外厂加工成品入库单编号点收记正确录检验专业文档考试资料学习资料教育试题方案设计
--
入库验收单
编号：日年月
入库名称数量
验收部门验收人员
□合格验结
收□记录果入门入入库库部单位库记录主经办主管管入库人
外厂加工成品入库单编号日年月单价成品名数量称总承制厂商价点收□超交□
VBA简单入门22：VBA中使用Countif制作入库单
VBA简单入门22：VBA中使用Countif制作入库单
展开全文
要实现对部门B的收入求和，可以使用函数Sumif。
在VBA中引用工作表函数Sumif函数，代码如下：
Dim R As Long
R = Cells(Rows.Count, 1).End(xlUp).Row
[e2] = Application.WorksheetFunction.SumIf(Range('a2:A' & R), [d2], Range('b2:b' & R))
尽管在代码中使用工作表函数常常被诟病为效率低下，但某些情况下工作表函数也是不错的选择。
在VBA简单入门11，我们尝试制作个入库单的录入数据功能。
今天，在VBA中使用工作表函数来实现剩下的删除、修改、查询功能。
文章链接：VBA简单入门11：Find方法
录入界面
数据表
1、删除功能
2、修改功能
先调用删除数据的代码，将数据表中的数据删除；然后重新录入修改后的数据。
这里使用了Call语句调用了录入数据这个过程。
3、查询功能
至此，一个简单的入库单就制作完毕，而这只需要用到很少很简单的VBA知识。
主要知识点：Find方法、Countif函数、Resize属性、End属性等。
因只是简单讲解入库单的制作过程，未严谨测试。
如若代码当中有错误之处，敬请指出。
文件下载：
链接: https:///s/1mAJr37NcB3e7yc5tNe2uOQ 密码: gbxe。
VBA库存管理案例
VBA库存管理案例⼀、查找' 调⽤⼯作表函数查找Sub t1() '判断是否存在，并查找所在⾏数Dim hao As IntegerDim icount As Integericount = Application.WorksheetFunction.CountIf(Sheets("库存明细表").[b:b], [g3])If icount > 0ThenMsgBox"该⼊库单号码已经存在，请不要重复输⼊"MsgBox Application.WorksheetFunction.Match([g3], Sheets("库存明细表").[b:b], 0)End IfEnd Sub' 使⽤find ⽅法Sub t2()Dim r As Integer, r1 As IntegerDim icount As Integericount = Application.WorksheetFunction.CountIf(Sheets("库存明细表").[b:b], [g3])If icount > 0Thenr = Sheets("库存明细表").[b:b].Find(Range("g3"), lookat:=xlwbole).Row ' 查找号码第次出现的位置r1 = Sheets("库存明细表").[b:b].Find([g3], , , , , xlPrevious).Row ' xlPrevious 向后查找MsgBox r & ":" & r1End IfEnd SubSub t3() '返回最下⼀⾏的⾮空⾏的⾏数MsgBox Sheets("库存明细表").Cells.Find("*", , , , , xlPrevious).RowEnd Sub案例：输⼊Sub输⼊()Dim c As Integer' 号码在库存表中的个数Dim r As Integer' ⼊库单的数据⾏数Dim cr As Integer' 库存明细表中的第⼀个空⾏的⾏数With Sheets("库存明细表")c = Application.CountIf([b:b], Range("g3"))If c > 0ThenMsgBox"该单据号码已经存在！请不要重复输⼊"Exit SubElser = Application.CountIf(Range("b6:b10"), "<>")cr = .[b65536].End(xlUp).Row + 1.Cells(cr, 1).Resize(r, 1) = range("e3").Cells(cr, 2).Resize(r, 1) = range("g3").Cells(cr, 3).Resize(r, 1) = range("c3").Cells(cr, 4).Resize(r, 6) = Cells(6, 2).Resize(r, 6).Value MsgBox"输⼊已完成"End IfEnd WithEnd Sub查找Sub查找()Dim c As Integer' 号码在库存表中的个数Dim r As Integer' ⼊库单的数据⾏数With Sheets("库存明细表")c = Application.CountIf([b:b], Range("g3"))If c = 0ThenMsgBox"该单据号码不存在！"Exit SubElser = .[b:b].Find(Range("g3"), , , , , xlNext).RowRange("c3") = .Cells(r, 3)Range("e3") = .Cells(r, 1)Cells(6, 2).Resize(e, 5) = Cells(r, 4).Resize(e, 5).Value MsgBox"查找已完成"End IfEnd WithEnd Sub删除Sub删除()Dim c As Integer' 号码在库存表中的个数Dim r As Integer' ⼊库单的数据⾏数With Sheets("库存明细表")c = Application.CountIf([b:b], Range("g3"))If c = 0ThenMsgBox"该单据号码不存在！"Exit SubElser = .[b:b].Find(Range("g3"), , , , , xlNext).Row.Range(r & ":" & c + r - 1).DeleteMsgBox"删除成功"End IfEnd WithEnd Sub修改Sub修改() Call删除Call输⼊End Sub。
VBA简单入门11：Find方法
1. Find方法的作用Find方法用来在指定的单元格区域中查找包含某个特定的数据，若找到符合条件的数据，则返回包含该数据的单元格（Range对象）；若未发现相匹配的数据（无匹配的单元格对象），则返回Nothing。
2. Find方法的语法[语法]<单元格区域>.Find ( What ，[After]，[LookIn]， [LookAt]，[SearchOrder]，[SearchDirection]， [MatchCase] ，[MatchByte]，[SearchFormat]) <单元格区域>.Find (要查找的数据，开始查找的位置，查找的范围类型，完全匹配还是部分匹配，行列方式查找，向前向后查找，区分大小写，全角或半角，查找格式)Find方法各个参数都可以在Excel常用的查找和替换操作框中找到对应，这里不一一阐述每个参数的作用。
3、 LookAt参数，精确查找OR模糊查找数据表格完全匹配（精确查找）：Sub vv() '完全匹配（精确查找）Dim Rng As RangeSet Rng = Range("a1:a11").Find("小乔", lookat:=xlWhole)'完全匹配（精确查找）Debug.Print Rng.AddressEnd Sub结果上面代码在单元格A1:A11中查找小乔，如找到，即返回小乔所在的单元格。
Find方法在省略SearchOrder（查找方向）的情况下，默认是从上到下查找。
所以，Find方法之后返回第一个小乔所在的单元格A2。
部分匹配（模糊查找）：查找的代码改为，同样可以找到小乔，注意查找的内容是包含“乔”这个字符的单元格。
Set Rng = Range("a1:a11").Find("乔", lookat:=xlPart) '模糊查找如果，找不到小乔这个单元格，则会返回Nothing（找不到对象，好惨！）所以，可以用Nothing来判断，是否找到想要的数据（单元格对象）。