用Excel建立数据录入系统.doc

《用Excel建立数据录入系统.doc》由会员上传分享，免费在线阅读，更多相关内容在应用文档-天天文库。

1、用Excel建立数据录入系统-升级版 (2013-09-0616:02:28)转载▼标签： excel vba分类： OFFICE一、数据采集系统功能录入、保存、查询、清空、修改二、两个界面1.数据录入界面：前台功能使用界面，实现“录入、保存、查询、清空、修改”；2.数据存储界面：后台实现数据的保存；录入界面：三、实现方法1.保存功能SubSave()''保存数据Marco，xiaohou制作，时间2013-9-5'Dimr1,r2,r3AsRangeWithSheets("数据存储")  Setr2=

2、.Range("a2",.[a100000].End(xlUp))EndWithWithSheets("数据录入")  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)    

3、IfNotr3IsNothingThen      MsgBox("此编码已存在，不可保存。如果此信息需要修改，请点击查询后再修改")    Else      Sheets("数据存储").Rows("2:35").InsertShift:=xlDown      .Range("c6:l39").Copy  '复制“数据录入”表体信息      Sheets("数据存储").Range("c2:l2").PasteSpecialPaste:=xlPasteValues      .Range("c4

4、").Copy      '复制“数据录入”编码      Sheets("数据存储").Range("a2:a35").PasteSpecialPaste:=xlPasteValues      .Range("e4").Copy      '复制“数据录入”名称      Sheets("数据存储").Range("b2:b35").PasteSpecialPaste:=xlPasteValues      r1.ClearContents       '保存数据后，清空录入界面      .Ran

5、ge("c4").Select    EndIf  EndIfEndWithEndSub2.查询功能SubQuery()''查询筛选Macro，xiaohou制作，时间2013-9-5''DimErowAsIntegerDimr1,r2AsRangeWithSheets("数据录入")  Setr1=.Range("d6:l39")  Setr2=.Range("a6:b39")    Erow=Sheets("数据存储").[a100000].End(xlUp).Row    r1.ClearCont

6、ents    '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"&

7、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

8、(xlEdgeTop).LineStyle=xlNone    r2.Borders(xlEdgeBottom).LineStyle=xlNone    'r2.Borders(xlEdgeRight).LineStyle=xlNone    r2.Borders(xlInsideVertical).LineStyle=xlNone    r2.Borders(xlInsideHorizontal).LineStyle=xlNone