如何通过EXCEL制作一个录入收集系统.docx
- 文档编号:19426713
- 上传时间:2023-04-24
- 格式:DOCX
- 页数:5
- 大小:71.36KB
如何通过EXCEL制作一个录入收集系统.docx
《如何通过EXCEL制作一个录入收集系统.docx》由会员分享,可在线阅读,更多相关《如何通过EXCEL制作一个录入收集系统.docx(5页珍藏版)》请在冰豆网上搜索。
如何通过EXCEL制作一个录入收集系统
如何通过EXCEL制作一个录入收集系统
如何通过EXCEL制作一个录入收集系统?
一、数据采集系统功能录入、保存、查询、清空、修改
二、两个界面
1.数据录入界面:
前台功能使用界面,实现“录入、保存、查询、清空、修改”;
2.数据存储界面:
后台实现数据的保存;录入界面:
三、实现方法1.保存功能SubSave()'
'保存数据Marco,xiaohou制作,时间2013-9-5'
Dimr1,r2,r3AsRangeWithSheets("数据存储")
Setr2=.Range("a2",.[a100000].End(xlUp))EndWith
WithSheets("数据录入") Setr1=.Range("c4:
e4,d6:
l39")
IfIsEmpty(.Range("c4"))OrIsEmpty(.Range("e4"))Then 'OrIsEmpty(.Range("b7:
b41"))添加科室不为空,未成功 MsgBox("编码、名称为空,不可保存!
") Else
Setr3=r2.Find(.Cells(4,3),,,1) IfNotr3IsNothingThen
MsgBox("此编码已存在,不可保存。
如果此信息需要修改,请点击查询后再修改")
Else
Sheets("数据存储").Rows("2:
35").InsertShift:
=xlDown
.Range("c6:
l39").Copy '复制“数据录入”表体信息
Sheets("数据存储").Range("c2:
l2").PasteSpecialPaste:
=xlPasteValues .Range("c4").Copy '复制“数据录入”编码
Sheets("数据存储").Range("a2:
a35").PasteSpecialPaste:
=xlPasteValues .Range("e4").Copy '复制“数据录入”名称
Sheets("数据存储").Range("b2:
b35").PasteSpecialPaste:
=xlPasteValues r1.ClearContents '保存数据后,清空录入界面
.Range("c4").Select EndIf EndIfEndWithEndSub
2.查询功能SubQuery()'
'查询筛选Macro,xiaohou制作,时间2013-9-5''
DimErowAsIntegerDimr1,r2AsRangeWithSheets("数据录入") Setr1=.Range("d6:
l39") Setr2=.Range("a6:
b39")
Erow=Sheets("数据存储").[a100000].End(xlUp).Row
r1.ClearContents
'ForEachceIn.[a2:
x2]
'Ifce<>""Thence.Value="*"&ce&"*" '加上通配符*,实现模糊查询
'Next
IfIsEmpty(.Range("c4"))OrIsEmpty(.Range("e4"))Then
'OrIsEmpty(.Range("b7:
b41"))添加科室不为空,未成功
MsgBox("编码、名称为空,不可查询!
") Else
Sheets("数据存储").Range("A1:
l"&Erow).AdvancedFilterAction:
=xlFilterCopy,CriteriaRange:
=_ .[c3:
e4],CopyToRange:
=.[A5:
l5],Unique:
=False
r2.Borders(xlDiagonalDown).LineStyle=xlNone r2.Borders(xlDiagonalUp).LineStyle=xlNone
r2.Borders(xlEdgeLeft).LineStyle=xlNone
r2.Borders(xlEdgeTop).LineStyle=xlNone
r2.Borders(xlEdgeBottom).LineStyle=xlNone
'r2.Borders(xlEdgeRight).LineStyle=xlNone r2.Borders(xlInsideVertical).LineStyle=xlNone
r2.Borders(xlInsideHorizontal).LineStyle=xlNone
r2.NumberFormatLocal=";;;"
'ForEachceIn.[a2:
x2]
'Ifce<>""Thence.Value=Mid(ce,2,Len(ce)-2) '取消"*"通配符
'Next EndIfEndWithEndSub
3.更新SubUpdate()'
'更新Macro,xiaohou制作,时间2013-9-5
Dimarr,dAsObject
DimrAsRange
Dimlr&,i&,j%
WithSheets("数据录入")'查询修改工作表数据区域写入数组arr
'arr=.Range("A7:
D"&.Range("A65536").End(xlUp).Row)
arr=.Range("a6:
l39")
Setr=.Range("d6:
l39")
EndWith
Setd=CreateObject("scripting.dictionary")'定义字典对象
Fori=1ToUBound(arr)'逐行
'IfLen(arr(i,2))<>0Then'排出“合计”行,即:
姓名务数据
IfNotd.exists(arr(i,1)&arr(i,2)&arr(i,3))Thend(arr(i,1)&arr(i,2)&arr(i,3))=arr(i,4)&Chr(9)&arr(i,5)_
&Chr(9)&arr(i,6)&Chr(9)&arr(i,7)&Chr(9)&arr(i,8)&Chr(9)&arr(i,9)&Chr(9)&arr(i,10)&Chr(9)&arr(i,11)&Chr(9)&arr(i,12)
'上一句:
如果编码和名称连接字符串字典不存在(首次出现,这里判断可能多余),这个字符串添加到字典键值,后续的相关属性字段用制表符连接添加到字典条目
'EndIf Next
WithSheets("数据存储")
lr=.Range("A100000").End(xlUp).Row'数据存储工作表数据行数
'.Range("C2:
D"&lr).SpecialCells(xlCellTypeConstants,23).ClearContents'清除C、D列不含公式单元格的值
arr=.Range("A2:
l"&lr)'数据存储工作表数据区域写入数组arr
Fori=1ToUBound(arr)'逐行
Ifd.exists(arr(i,1)&arr(i,2)&arr(i,3))Then'如果编码和名称连接字符串字典存在,即Sheet2中有
Forj=4To12'D、E、F...列逐列
'IfNotCells(i,j).HasFormulaThenCells(i,j)=Split(d(arr(i,1)&arr(i,2)),Chr(9))(j-3)
'上句:
如果单元格不含公式,把Sheet2对应的数据写入这个单元格
.Cells(i + 1, j) = Split(d(arr(i, 1) & arr(i, 2) & arr(i, 3)), Chr(9))(j - 4)
Next
End If
Next
End With
r.ClearContents
Sheets("
数据录入
").Cells(4, 3).Select
MsgBox ("
数据已更新完成,若要查看更新后的内容,请点击按钮查询")
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- 如何 通过 EXCEL 制作 一个 录入 收集 系统