vba工作簿提取需要的表格数据（用EXCELVBA做一个采购单）
vba工作簿提取需要的表格数据（用EXCELVBA做一个采购单）点击区域3. 物资名称下面的10个空格，可以点击触发页面跳转事件，跳到“物料”表，去选择需要的物料后自动返回到本页。可编辑单号新建一个“物料”表，格式如下物料表
二：手动更改单号与录入保存
现在，我们要实现以下的功能
1. A2单元格点击一次，单号自动 1（为了防止长时间不操作忘记自己有没有更改单号）
2. 同时该单元格还可以自由编辑（允许用户改成其它格式单号）
可编辑单号
新建一个“物料”表，格式如下
物料表
3. 物资名称下面的10个空格，可以点击触发页面跳转事件，跳到“物料”表，去选择需要的物料后自动返回到本页。
点击区域
由于都是鼠标事件触发的，以上功能全部写在一起：
'鼠标点击事件监听
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'点击A2单元格后自动递加单号
If Target.Column = 1 And Target.Row = 2 Then '第1列第2行就是A2
'清空输入表，单号改变表示要做新单了
Range("B8:F17") = "" 'B8-F17内容清空
Range("H8:H17") = "" 'H8-H17内容清空
Cells(8 2).Value = "以下空白" '没有内容则自动填写“以下空白”字样
'Range("a5").Select
'下面自动填写日期
dates = Application.Text(Now() "yyyy/mm/dd")
'格式化日期为字符串
d = Replace(dates "/" "")
'获取单号里的日期
d0 = Mid(Range("a2").Value 9 8)
'获取当前单号尾缀
st = Right(Range("a2").Value 3)
'判断是否为数字
If IsNumeric(Right(st 1)) Then
'日期相同尾缀自动 1
If d <> d0 Then
nst = 1
Else
'输出数字类型
nst = CInt(st)
nst = nst 1
End If
'格式化单号尾缀为三位数
nst = Format(nst "000")
'自动填写单号
Range("a2").Value = "采购方单号:" & "CG" & d & nst
Else
'单号为空时，自动填写单号为001
Sheets("采购单").Range("a2").Value = "采购方单号:" & "CG" & d & "001"
End If
End If
'监控点击区域，鼠标点击在第二列第8-17行时，会转到物料页面
If Target.Column = 2 And Target.Row > 7 And Target.Row < 18 Then
Cells(Target.Row 5).Select
'我们在“物料”表的G1单元格记录下当前鼠标点击的是第几行，等会选择物料后再根据这个行数将内容回填
Sheets("物料").Range("G1") = Target.Row
Sheets("物料").Select
End If
''点击第1列第7-18行的序号，会清空该行内容
tr = Target.Row
If Target.Column = 1 And tr > 7 And tr < 18 Then
Cells(tr 2) = ""
Cells(tr 3) = ""
Cells(tr 4) = ""
Cells(tr 5) = ""
Cells(tr 6) = ""
Cells(tr 8) = ""
End If
End Sub
“采购单”页的[小计]和[合计]公式就不在这里说了，小计等于前面的数量X单价，合计是所有小计的总和
4. 如果单据填写完成确认无误了，我们还需要保存一下
1. 新建一个“数据”工作表
2. 数据表格式如下：
3. 回到“采购单”页面，做一个点击按钮控件，点一下它就保存“采购单”的内容。
从[开发工具]－〉[插入]－〉ActiveX控件＝命令按钮
插入按钮
将文档设置成[设计模式]，右击[保存表单]，可以设置其属性，文本格式颜色等，我们将它的名字改为btn
设置属性
这个按钮我们只想它能看到能用到，但打印的时候不能打出来，那就右击它，{设置控件格式}，属性－〉取消[打印对象]前的勾，这样打印的时候就不会出现了。
不打印
在“采购单”页面的代码栏最底下，追加按钮点击事件
Private Sub btn_Click() '当按钮点击时
'截取当前单号
dh = Split(Range("a2") ":")
'查找是否存在单号
Set r = Sheets("数据").Range("a1:a60000").Find(dh(1) lookat:=xlWhole)
'如果没有查找到有重复单号就开始记录
If r Is Nothing Then
'单号、日期、名称、规格、数量、单价、备注
Set sh = Sheets("数据")
Set sh1 = Sheets("采购单")
For i = 8 To 17
If sh1.Cells(i 3).Value <> "" Then
'将“采购单”页的内容按行填写插入“数据”表的第二行
dates = Application.Text(Now() "yyyy/mm/dd hh:mm:ss")
sh.Rows(2).Insert
sh.Cells(2 1).Value = dh(1)
sh.Cells(2 2).Value = dates
sh.Cells(2 3).Value = sh1.Cells(i 2).Value
sh.Cells(2 4).Value = sh1.Cells(i 3).Value
sh.Cells(2 5).Value = sh1.Cells(i 4).Value
sh.Cells(2 6).Value = sh1.Cells(i 6).Value
sh.Cells(2 7).Value = sh1.Cells(i 8).Value
End If
Next
End If
MsgBox "表单已保存"
End Sub
现在可以取消[设计模式]了。
下一篇再续
