資源描述：
《用Excel建立數(shù)據(jù)錄入系統(tǒng).doc》由會員上傳分享，免費(fèi)在線閱讀，更多相關(guān)內(nèi)容在應(yīng)用文檔-天天文庫。
1、用Excel建立數(shù)據(jù)錄入系統(tǒng)-升級版?(2013-09-0616:02:28)轉(zhuǎn)載▼標(biāo)簽：?excel?vba分類：?OFFICE一、數(shù)據(jù)采集系統(tǒng)功能錄入、保存、查詢、清空、修改二、兩個(gè)界面1.數(shù)據(jù)錄入界面：前臺功能使用界面，實(shí)現(xiàn)“錄入、保存、查詢、清空、修改”；2.數(shù)據(jù)存儲界面：后臺實(shí)現(xiàn)數(shù)據(jù)的保存；錄入界面：三、實(shí)現(xiàn)方法1.保存功能SubSave()''保存數(shù)據(jù)Marco，xiaohou制作，時(shí)間2013-9-5'Dimr1,r2,r3AsRangeWithSheets("數(shù)據(jù)存儲")??Setr2=
2、.Range("a2",.[a100000].End(xlUp))EndWithWithSheets("數(shù)據(jù)錄入")??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("此編碼已存在，不可保存。如果此信息需要修改，請點(diǎn)擊查詢后再修改")????Else??????Sheets("數(shù)據(jù)存儲").Rows("2:35").InsertShift:=xlDown??????.Range("c6:l39").Copy??'復(fù)制“數(shù)據(jù)錄入”表體信息??????Sheets("數(shù)據(jù)存儲").Range("c2:l2").PasteSpecialPaste:=xlPasteValues??????.Range("c4
4、").Copy??????'復(fù)制“數(shù)據(jù)錄入”編碼??????Sheets("數(shù)據(jù)存儲").Range("a2:a35").PasteSpecialPaste:=xlPasteValues??????.Range("e4").Copy??????'復(fù)制“數(shù)據(jù)錄入”名稱??????Sheets("數(shù)據(jù)存儲").Range("b2:b35").PasteSpecialPaste:=xlPasteValues??????r1.ClearContents???????'保存數(shù)據(jù)后，清空錄入界面??????.Ran
5、ge("c4").Select????EndIf??EndIfEndWithEndSub2.查詢功能SubQuery()''查詢篩選Macro，xiaohou制作，時(shí)間2013-9-5''DimErowAsIntegerDimr1,r2AsRangeWithSheets("數(shù)據(jù)錄入")??Setr1=.Range("d6:l39")??Setr2=.Range("a6:b39")????Erow=Sheets("數(shù)據(jù)存儲").[a100000].End(xlUp).Row????r1.ClearCont
6、ents????'ForEachceIn.[a2:x2]????????'Ifce<>""Thence.Value="*"&ce&"*"???'加上通配符*,實(shí)現(xiàn)模糊查詢????'Next??IfIsEmpty(.Range("c4"))OrIsEmpty(.Range("e4"))Then????'OrIsEmpty(.Range("b7:b41"))添加科室不為空，未成功????MsgBox("編碼、名稱為空，不可查詢！")??Else????Sheets("數(shù)據(jù)存儲").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????
