資源描述：
《VBA在統(tǒng)計(jì)中運(yùn)用淺嘗》由會(huì)員上傳分享，免費(fèi)在線閱讀，更多相關(guān)內(nèi)容在教育資源-天天文庫(kù)。
1、VBA在統(tǒng)計(jì)中運(yùn)用淺嘗廣漢市新豐小學(xué)王益樹(shù)摘要：辦公中往往要遇到重復(fù)的數(shù)據(jù)收集，但如果使用復(fù)制、粘貼的辦法會(huì)繁瑣而易出錯(cuò)，機(jī)器也吃不消，運(yùn)用VBA可能獲得事半功倍的效果。關(guān)鍵詞：VBA數(shù)據(jù)自泰勒時(shí)代開(kāi)始，數(shù)學(xué)與統(tǒng)計(jì)在生產(chǎn)管理科學(xué)的不斷進(jìn)步中就一直居于支配地位。作為一名涉及有關(guān)數(shù)據(jù)統(tǒng)計(jì)人員，不但需要學(xué)習(xí)各種先進(jìn)的管理理念，更需要學(xué)習(xí)這些理念的實(shí)戰(zhàn)應(yīng)用方法。本次在針對(duì)“國(guó)家學(xué)生體質(zhì)健康標(biāo)準(zhǔn)數(shù)據(jù)管理”數(shù)據(jù)處理時(shí)，嘗試運(yùn)用VBA來(lái)進(jìn)行統(tǒng)計(jì)，使用我再次認(rèn)識(shí)到它的便利，大大提高了工作效率。工作情況：本校共27個(gè)班，900百余人，每收集數(shù)據(jù)20余項(xiàng)。如（圖一）（圖一
2、）工作思路：首先生成以班為單位含個(gè)人信息的獨(dú)立表格；其次分發(fā)給每位體育教師進(jìn)行填寫；最后收集匯總。首先，在全校學(xué)生信息中寫入VBA代碼：OptionExplicitSubExtractReps()Dimws1AsWorksheetDimwsNewAsWorksheetDimrngAsRangeDimrAsIntegerDimcAsRangeSetws1=Sheets("Sheet1")Setrng=Range("Database")'extractalistofSalesRepsws1.Columns("C:C").AdvancedFilter_Act
3、ion:=xlFilterCopy,_CopyToRange:=Range("V1"),Unique:=Truer=Cells(Rows.Count,"V").End(xlUp).Row'setupCriteriaAreaRange("X1").Value=Range("C1").ValueForEachcInRange("V2:V"&r)'addtherepnametothecriteriaareaws1.Range("X2").Value=c.Value'addnewsheetandrunadvancedfilterSetwsNew=Sheets.
4、AddwsNew.MoveAfter:=Worksheets(Worksheets.Count)wsNew.Name=c.Valuerng.AdvancedFilterAction:=xlFilterCopy,_CriteriaRange:=Sheets("Sheet1").Range("X1:X2"),_CopyToRange:=wsNew.Range("A1"),_Unique:=FalseNextws1.Selectws1.Columns("V:X").DeleteEndSub執(zhí)行后生成（圖二）（圖二）再把每一個(gè)工作簿生成獨(dú)立的EXCLE文件，寫
5、入VBA代碼：Sub另存所有工作表為工作簿()DimshtAsWorksheetApplication.ScreenUpdating=False'禁用屏幕刷新ipath=ThisWorkbook.Path&""'當(dāng)前工作簿的文件目錄ForEachshtInSheetssht.CopyActiveWorkbook.SaveAsipath&sht.Name&".xls"'(工作表名稱為文件名）ActiveWorkbook.CloseNextApplication.ScreenUpdating=True'恢復(fù)屏幕刷新EndSub執(zhí)行后生成（圖三）（圖三）其
6、次，把生成的文件分發(fā)給每位填寫人員，進(jìn)行數(shù)據(jù)數(shù)據(jù)錄入，核對(duì)。最后，在空表中寫入VBA代碼：SubSilent_open1()DimMyPath,MyName,AWbNameDimWbAsWorkbook,WbNAsStringDimGAsLong,JAsLongDimNumAsLongDimBOXAsStringMyPath=ActiveWorkbook.PathMyName=Dir(MyPath&""&"*.xls")AWbName=ActiveWorkbook.NameNum=0BOX=InputBox("請(qǐng)輸入您要合并的工作表號(hào)，以阿拉伯?dāng)?shù)值為
7、準(zhǔn)。"&Chr(13)&Chr(13)&_"如要合并工作簿的第2張工作表，則輸入“2”。"&Chr(13)&Chr(13)&_"默認(rèn)值為“1”。","輸入",1)IfBOX=""ThenExitSubElseIfIsNumeric(BOX)=FalseThenMsgBox"請(qǐng)輸入數(shù)值型數(shù)據(jù)。",vbCritical,"Error"ExitSubElseIfVal(BOX)<>Int(Val(BOX))ThenMsgBox"請(qǐng)輸入整數(shù)。",vbCritical,"Error"ExitSubElseIfVal(BOX)<0ThenMsgBox"請(qǐng)輸入正整數(shù)
8、。",vbCritical,"Error"ExitSubElseIfVal(BOX)>255T
