各种Excel VBA的命令

各种ExcelVBA的命令[part1]2007-07-3111:15本示例为设置工作表密码ActiveSheet.ProtectPassword:=641112'保护工作表并设置密码ActiveSheet.UnprotectPassword:=641112'撤消工作表保护并取消密码'本示例保存当前活动工作簿的副本。ActiveWorkbook.SaveCopyAs"C:\TEMP\XXXX.XLS"'本示例通过将Saved属性设为True来关闭包含本段代码的工作簿，并放弃对该工作簿的任何更改。ThisWorkbook.Saved=TrueThisWorkbook.Close'本示例对自动重新计算功能进行设置，使MicrosoftExcel不对第一张工作表自动进行重新计算。Worksheets(1).EnableCalculation=False'下述过程打开C盘上名为MyFolder的文件夹中的MyBook.xls工作簿。Workbooks.Open("C:\MyFolder\MyBook.xls")'本示例显示活动工作簿中工作表sheet1上单元格A1中的值。MsgBoxWorksheets("Sheet1").Range("A1").Value本示例显示活动工作簿中每个工作表的名称ForEachwsInWorksheetsMsgBoxws.NameNextws本示例向活动工作簿添加新工作表,并设置该工作表的名称?SetNewSheet=Worksheets.AddNewSheet.Name="currentBudget"本示例将新建的工作表移到工作簿的末尾'PrivateSubWorkbook_NewSheet(ByValShAsObject)Sh.MoveAfter:=Sheets(Sheets.Count)EndSub本示例将新建工作表移到工作簿的末尾'PrivateSubApp_WorkbookNewSheet(ByValWbAsWorkbook,_ByValShAsObject)Sh.MoveAfter:=Wb.Sheets(Wb.Sheets.Count)EndSub本示例新建一张工作表，然后在第一列中列出活动工作簿中的所有工作表的名称。SetNewSheet=Sheets.Add(Type:=xlWorksheet)Fori=1ToSheets.CountNewSheet.Cells(i,1).Value=Sheets(i).NameNexti本示例将第十行移到窗口的最上面?Worksheets("Sheet1").ActivateActiveWindow.ScrollRow=10当计算工作簿中的任何工作表时，本示例对第一张工作表的A1:A100区域进行排序。'PrivateSubWorkbook_SheetCalculate(ByValShAsObject)WithWorksheets(1).Range("a1:a100").SortKey1:=.Range("a1")EndWithEndSub本示例显示工作表Sheet1的打印预览。Worksheets("Sheet1").PrintPreview本示例保存当前活动工作簿?ActiveWorkbook.Save本示例保存所有打开的工作簿，然后关闭MicrosoftExcel。ForEachwInApplication.Workbooksw.SaveNextwApplication.Quit下例在活动工作簿的第一张工作表前面添加两张新的工作表?Worksheets.AddCount:=2,Before:=Sheets(1)本示例设置15秒后运行my_Procedure过程，从现在开始计时。Application.OnTimeNow+TimeValue("00:00:15"),"my_Procedure"本示例设置my_Procedure在下午5点开始运行。Application.OnTimeTimeValue("17:00:00"),"my_Procedure"本示例撤消前一个示例对OnTime的设置。Application.OnTimeEarliestTime:=TimeValue("17:00:00"),_Procedure:="my_Procedure",Schedule:=False每当工作表重新计算时，本示例就调整A列到F列的宽度。'PrivateSubWorksheet_Calculate()Columns("A:F").AutoFitEndSub本示例使活动工作簿中的计算仅使用显示的数字精度。ActiveWorkbook.PrecisionAsDisplayed=True本示例将工作表Sheet1上的A1:G37区域剪下，并放入剪贴板。Worksheets("Sheet1").Range("A1:G37").CutCalculate方法计算所有打开的工作簿、工作簿中的一张特定的工作表或者工作表中指定区域的单元格，如下表所示：'要计算'依照本示例所有打开的工作簿'Application.Calculate（或只是Calculate）指定工作表'计算指定工作表Sheet1Worksheets("Sheet1").Calculate指定区域'Worksheets(1).Rows(2).Calculate本示例对自动重新计算功能进行设置，使MicrosoftExcel不对第一张工作表自动进行重新计算。Worksheets(1).EnableCalculation=False本示例计算Sheet1已用区域中A列、B列和C列的公式。Worksheets("Sheet1").UsedRange.Columns("A:C").Calculate本示例更新当前活动工作簿中的所有链接?ActiveWorkbook.UpdateLinkName:=ActiveWorkbook.LinkSources本示例设置第一张工作表的滚动区域?Worksheets(1).ScrollArea="a1:f10"本示例新建一个工作簿，提示用户输入文件名，然后保存该工作簿。SetNewBook=Workbooks.AddDofName=Application.GetSaveAsFilenameLoopUntilfNameFalseNewBook.SaveAsFilename:=fName本示例打开Analysis.xls工作簿，然后运行Auto_Open宏。Workbooks.Open"ANALYSIS.XLS"ActiveWorkbook.RunAutoMacrosxlAutoOpen本示例对活动工作簿运行Auto_Close宏，然后关闭该工作簿。WithActiveWorkbook.RunAutoMacrosxlAutoClose.CloseEndWith在本示例中，MicrosoftExcel向用户显示活动工作簿的路径和文件名称。'SubUseCanonical()Displaythefullpathtouser.MsgBoxActiveWorkbook.FullNameURLEncodedEndSub本示例显示当前工作簿的路径及文件名（假定尚未保存此工作簿）。MsgBoxActiveWorkbook.FullName本示例关闭Book1.xls，并放弃所有对此工作簿的更改。Workbooks("BOOK1.XLS").CloseSaveChanges:=False本示例关闭所有打开的工作簿。如果某个打开的工作簿有改变，MicrosoftExcel将显示询问是否保存更改的对话框和相应提示。Workbooks.Close本示例在打印之前对当前活动工作簿的所有工作表重新计算?'PrivateSubWorkbook_BeforePrint(CancelAsBoolean)ForEachwkInWorksheetswk.CalculateNextEndSub本示例对查询表一中的第一列数据进行汇总，并在数据区域下方显示第一列数据的总和。Setc1=Sheets("sheet1").QueryTables(1).ResultRange.Columns(1)c1.Name="Column1"c1.End(xlDown).Offset(2,0).Formula="=sum(Column1)"本示例取消活动工作簿中的所有更改?ActiveWorkbook.RejectAllChanges本示例在商业问题中使用规划求解函数，以使总利润达到最大值。SolverSave函数将当前问题保存到活动工作表上的某一区域。Worksheets("Sheet1").ActivateSolverResetSolverOptionsPrecision:=0.001SolverOKSetCell:=Range("TotalProfit"),_MaxMinVal:=1,_ByChange:=Range("C4:E6")SolverAddCellRef:=Range("F4:F6"),_Relation:=1,_FormulaText:=100SolverAddCellRef:=Range("C4:E6"),_Relation:=3,_FormulaText:=0SolverAddCellRef:=Range("C4:E6"),_Relation:=4SolverSolveUserFinish:=FalseSolverSaveSaveArea:=Range("A33")本示例隐藏Chart1、Chart3和Chart5。Charts(Array("Chart1","Chart3","Chart5")).Visible=False当激活工作表时，本示例对A1:A10区域进行排序。'PrivateSubWorksheet_Activate()Range("a1:a10").SortKey1:=Range("a1"),Order:=xlAscendingEndSub本示例更改MicrosoftExcel链接。ActiveWorkbook.ChangeLink"c:\excel\book1.xls",_"c:\excel\book2.xls",xlExcelLinks本示例启用受保护的工作表上的自动筛选箭头?ActiveSheet.EnableAutoFilter=TrueActiveSheet.Protectcontents:=True,userInterfaceOnly:=True本示例将活动工作簿设为只读?ActiveWorkbook.ChangeFileAccessMode:=xlReadOnly本示例使共享工作簿每三分钟自动更新一次?ActiveWorkbook.AutoUpdateFrequency=3下述Sub过程清除活动工作簿中Sheet1上的所有单元格的内容。'SubClearSheet()Worksheets("Sheet1").Cells.ClearContentsEndSub本示例对所有工作簿都关闭滚动条?Application.DisplayScrollBars=False如果具有密码保护的工作簿的文件属性没有加密，则本示例设置指定工作簿的密码加密选项。'SubSetPasswordOptions()WithActiveWorkbookIf.PasswordEncryptionProvider"MicrosoftRSASChannelCryptographicProvider"Then.SetPasswordEncryptionOptions_PasswordEncryptionProvider:="MicrosoftRSASChannelCryptographicProvider",_PasswordEncryptionAlgorithm:="RC4",_PasswordEncryptionKeyLength:=56,_PasswordEncryptionFileProperties:=TrueEndIfEndWithEndSub在本示例中，如果活动工作簿不能进行写保护，那么MicrosoftExcel设置字符串密码以作为活动工作簿的写密码。'SubUseWritePassword()DimstrPasswordAsStringstrPassword="secret"'Setpasswordtoastringifallowed.IfActiveWorkbook.WriteReserved=FalseThenActiveWorkbook.WritePassword=strPasswordEndIfEndSub在本示例中，MicrosoftExcel打开名为Password.xls的工作簿，设置它的密码，然后关闭该工作簿。本示例假定名为Password.xls的文件位于C:\驱动器上。'SubUsePassword()DimwkbOneAsWorkbookSetwkbOne=Application.Workbooks.Open("C:\Password.xls")wkbOne.Password="secret"wkbOne.Close'注意Password属性可读并返回“********”。EndSub本示例将Book1.xls的当前窗口更改为显示公式。Workbooks("BOOK1.XLS").Worksheets("Sheet1").ActivateActiveWindow.DisplayFormulas=True'本示例接受活动工作簿中的所有更改?ActiveWorkbook.AcceptAllChanges本示例显示活动工作簿的路径和名称SubUseCanonical()MsgBox'消息框[b7]=ActiveWorkbook.FullName'当前工作簿[b8]=ActiveWorkbook.FullNameURLEncoded'活动工作簿EndSub本示例显示MicrosoftExcel启动文件夹的完整路径。MsgBoxApplication.StartupPathActivate事件激活一个工作簿、工作表、图表或嵌入图表时产生此事件。当激活工作表时，本示例对A1:A10区域进行排序。PrivateSubWorksheet_Activate()Range("a1:a10").SortKey1:=Range("a1"),Order:=xlAscendingEndSubCalculate事件对于Worksheet对象，在对工作表进行重新计算之后产生此事件每当工作表重新计算时，本示例就调整A列到F列的宽度。PrivateSubWorksheet_Calculate()Columns("A:F").AutoFitEndSub本示例向活动工作簿添加新工作表，并设置该工作表的名称。SetnewSheet=Worksheets.AddnewSheet.Name="currentBudget"本示例关闭工作簿Book1.xls，但不提示用户保存所作更改。Book1.xls中的所有更改都不会保存。Application.DisplayAlerts=FalseWorkbooks("BOOK1.XLS").CloseApplication.DisplayAlerts=True示例显示每一个可用加载宏的路径及文件名。ForEachaInAddInsMsgBoxa.FullNameNextaChDir语句改变当前的目录或文件夹。ChDirpath在PowerMacintosh中，默认驱动器总是改为在path语句中指定的驱动器。完整路径指定由卷标名开始，相对路径由冒号(:)开始.ChDir可以辨认路径中指定的别名:ChDir"MacDrive:Tmp"'在Macintosh中本示例显示当前路径分隔符。MsgBox"Thepathseparatorcharacteris"&_Application.PathSeparatorMove方法将一个指定的文件或文件夹从一个地方移动到另一个地方。语法object.MovedestinationMove方法语法有如下几部分：部分描述object必需的。始终是一个File或Folder对象的名字。destination必需的。文件或文件夹要移动到的目标。不允许有通配符。CreateFolder方法创建一个文件夹。语法object.CreateFolder(foldername)reateFolder方法有如下几部分：部分描述object必需的。始终是一个FileSystemObject的名字。foldername必需的。字符串表达式，它标识创建的文件夹。本示例使用MkDir语句来创建目录或文件夹。如果没有指定驱动器，新目录或文件夹将会建在当前驱动器中。MkDir"MYDIR"'建立新的目录或文件夹。Name语句示例本示例使用Name语句来更改文件的名称。示例中假设所有使用到的目录或文件夹都已存在。在Macintosh中，默认驱动器名称是“HD”并且路径部分由冒号取代反斜线隔开。DimOldName,NewNameOldName="OLDFILE":NewName="NEWFILE"'定义文件名。NameOldNameAsNewName'更改文件名。OldName="C:\MYDIR\OLDFILE":NewName="C:\YOURDIR\NEWFILE"NameOldNameAsNewName'更改文件名，并移动文件。本示例设置替换启动文件夹。Application.AltStartupPath="C:\EXCEL\MACROS"FolderExists方法如果指定的文件夹存在返回True，不存在返回False。语法object.FolderExists(folderspec)本示例在单元格中启用编辑。Application.EditDirectlyInCell=True程序说明：几种用VBA在单元格输入数据的方法：PublicSubWrites()1--2方法，最简单在"[]"中输入单元格名称。1[A1]=100'在A1单元格输入100。2[A2:A4]=10'在A2:A4单元格输入10。3--4方法，采用Range("")，""中输入单元格名称。3Range("B1")=200'在B1单元格输入200。4Range("C1:C3")=300'在C1:C3单元格输入300。5--6方法，采用Cells(Row,Column)，Row是单元格行数，Column是单元格栏数。5Cells(1,4)=400'在D1单元格输入400。6Range(Cells(1,5),Cells(5,5))=50'在E1:E5单元格输入50。EndSubVBALesson3程序说明：如何利用Worksheet_SelectionChange输入数据的方法。PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)Target=100EndSubVBALesson4程序说明：如何利用Worksheet_SelectionChange在限定的单元格输入数据的方法。PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)IfTarget.Row>=2AndTarget.Column=2ThenTarget=100EndIfEndSubVBALesson5程序说明：比较Worksheet_SelectionChange()与用按钮CommandButton1_Click()来执行程序二者的方法与写法有何不同。Worksheet_SelectionChange()事件PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)IfTarget.Row>=2AndTarget.Column=2ThenTarget=100EndIfEndSub按鈕CommandButton1_Click()PrivateSubCommandButton1_Click()IfActiveCell.Row>=2AndActiveCell.Column>=3ThenActiveCell=100EndIfEndSub二者执行方法最大的地方，在于Worksheet_SelectionChange()是自动的，你不用了解他是怎么完成工作的。按钮CommandButton1_Click()是人工的，比SelectionChange()多一道手续，就是要去按那接钮，程序才会执行。SelectionChange()有一个参数Target可用；CommandButton1_Click()没有。所以我们要用ActiveCell内定函数来取代Target，ActiveCell与Target最大的不同点他只能指定一个单元格。就是你选取多个单元格也只有最上面的单元格会加上数据；用Selection取代ActiveCell，用法就跟Target一样了。VBALesson6程序说明：完整的If...Then┅End逻辑判断式。PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)IfTarget.Row>=2AndTarget.Column=2ThenTarget=200ElseIfTarget.Row>=2AndTarget.Column=3ThenTarget=300ElseIfTarget.Row>=2AndTarget.Column=2ThenTarget=400ElseTarget=500EndIfEndSub这是个完整的If逻辑判断式，意思是说，假如If後的判断式条件成立的话，就执行第二条程序，否则假如ElseIf後的判断式条件成立的话，就执行第四条程序，否则假如另一个ElseIf後的判断式条件成立的话，就执行第六条程序。Else的意思是说，假如以上条件都不成立的话，就执行第八条程序。他的执行方式是假如IF的条件成立的话，就不执行其它ElseIf及Else的逻辑判断式，假如If後的条件不成立的话才会执行ElseIf或Else逻辑判断式。第二个ElseIf後的条件因为与IF後的条件一样，所以这个判断式後面的Target=400将是永远无法执行到的程序。VBALesson7程序说明∶我们为什麽要用变数。PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)Dimi,jAsIntegerDimkAsRangei=Target.Rowj=Target.ColumnSetk=TargetIfi>=2Andj=2Thenk=200ElseIfi>=2Andj=3Thenk=300ElseIfi>=2Andj=4Thenk=400Elsek=500EndIfEndSubPrivateSubWorksheet_Change(ByValTargetAsRange)DimiRow,iColAsIntegeriRow=Target.RowiCol=Target.ColumnIfiRow>=2AndiCol=2AndTarget""ThenApplication.EnableEvents=FalseCells(iRow,iCol+1)=Cells(iRow,iCol)*2Application.EnableEvents=TrueElseIfiRow>=2AndiCol=2AndTarget=""ThenCells(iRow,iCol+1)=""ElseCells(iRow,iCol+1)=""EndIfEndSub前几个教程都是用Worksheet_SelectionChange事件来举例子，大家应该能体会他是怎厶一回事了吧。这个教程就是要让你来体会什厶是Worksheet_Chang()事件。因为这二个事件在VBA都是非常有用的，所以一定要了解。简单的说，前者是你鼠标移动到那个单元格，就触发那个事件的执行。後者是要等到你点选的单元格，数?有了改变才会触发事件的执行。二者执行的时机一前一後。Target""是代表限定当前的单元格要是有数?的，才会执行以下三行的程序。Cells(iRow,iCol+1)=Cells(iRow,iCol)*2，是你在B栏输入数?时，C栏将可得到B栏二倍的数?。Target=""是限定当前的单元格要是没有数?的，才会执行以下一行的程序。Cells(iRow,iCol+1)=""，是把C栏的数?清成空格。Application.EnableEvents=False与Application.EnableEvents=True，这是个成双的程序，当你用了前者记得在执行其他程序後要写上後面的程序。它的目的在抑制事件连锁执行。简单的说就是，在B字段所触发的事件，不愿在其它单元格再触发另一个Worksheet_Change()事件。VBALesson9程序说明∶体会一下Worksheet_Change()事件连锁反应。PrivateSubWorksheet_Change(ByValTargetAsRange)DimiRowAsIntegeriRow=Target.RowApplication.EnableEvents=FalseCells(iRow,3)=Cells(iRow,3)+Cells(iRow,2)Application.EnableEvents=TrueEndSubPrivateSubWorksheet_Change(ByValTargetAsRange)DimiRowAsIntegeriRow=Target.Row'Application.EnableEvents=FalseCells(iRow,3)=Cells(iRow,3)+Cells(iRow,2)'Application.EnableEvents=TrueEndSub这个程序的目的是要在B2输入新的数?时，C2会将B2输入的新数?加上C2原有的数?呈现在C2上。照上面有加上Application.EnableEvents=False程序执行当然没问题。现在你在Application.EnableEvents=False与Application.EnableEvents=True前加上「'」看看。程序前加上「'」的目的是要使「'」之后的文字变成说明文字，程序执行时是会跳过说明文字，不执行说明文字的内容。程序前加上「'」符号后，文字会变成绿色。执行第二个程序时，你将发现C2不会按你所要求的，呈现结果。这就是所谓的事件连锁反应。请问这个宏该如何写!我想运行一个宏,就能在当前工作表B3上填上一条公式;这条公式的结果是所有工作表上的B4单元格的和.请问这个宏该如何写.谢谢!Subgg()DimshAsWorksheet,shname$ForEachshInWorksheetsshname=sh.NameActiveSheet.Range("b3").value=ActiveSheet.Range("b3").value+Worksheets(shname).Range("b4")NextEndSubVBA中怎样创建一个名为“table”的新工作表通过VBA编程，很容易添加新的工作表，但是新表的名字不知怎样控制，对于新创建的工作表，由于其名字并非特定，所以就不好使用所创建的新表了。不知各位有何高见。。。。Sheets.AddActiveSheet.Name="table"请教：如何用VBA检索表1中A列与表2，3，4，5.....中A列相同的行并把后者整行拷贝到表1检索到的行中,谢谢!!!!Toyxptwq∶用这程序试看看。SubCopy1()DimRow_dn1,Row_dnN,i,j,nAsIntegerRow_dn1=Sheet1.Range("A65536").End(xlUp).Rowk=1:n=1ForEachwSheetInActiveWorkbook.WorksheetsWithwSheetIf.Name"Sheet1"ThenRow_dnN=.Range("A65536").End(xlUp).RowFori=2ToRow_dn1Forj=2ToRow_dnNIf.Cells(j,1)=Sheet1.Cells(i,1)Then.Rows(j&":"&j).CopyDestination:=Sheet1.Rows(Row_dn1+n&":"&Row_dn1+n)n=n+1EndIfNextjNextiEndIfEndWithNextwSheetEndSub如果要用VBA程式输入密码使用下列程式码SubEnterNewPW()'程式说明:利用SendKey输入VBAProject密码' 注意事项 软件开发合同注意事项软件销售合同注意事项电梯维保合同注意事项软件销售合同注意事项员工离职注意事项 :执行本程式需要在Excel视窗,不能在VBE视窗Application.SendKeys"%{F11}",True'Alt+F11切换到VBA视窗Application.SendKeys"%T",True'ALT+T工具(繁体中文是(T))Application.SendKeys"e",True'工具(T)-VBproject属性(E)Application.SendKeys"^{TAB}",True'TAB键(切换到PAge2保护页面)Application.SendKeys"{+}",True'选取Checkbox方块(锁定专案以供检视)'({+}选取,{-}取消选取)Application.SendKeys"{TAB}",True'TAB键(跳到第一次输入密码TextboxmyPW="chijanzen"'假设密码chijanzenApplication.SendKeysmyPW,True'输入密码Application.SendKeys"{TAB}",True'TAB键(跳到第二次输入密码TextboxApplication.SendKeysmyPW,True'输入密码Application.SendKeys"{ENTER}",True'按确定钮(预设值)Application.SendKeys"%{F11}",True'返回Excel视窗EndSub冒泡排序法：冒泡排序法之所以成为“冒泡排序”是因为值较小的或是较轻的元素浮到作为继续排序的一组数的顶部。SubMacro1()DimiAsIntegerDimjAsIntegerDimtasintegerStaticnumber(1To10)AsIntegerFori=1To10number(i)=inputbox“输入要排序的数：”NextiFori=10To2Step-1Forj=1Toi–1‘下面进行位置交换Ifnumber(j)>number(j+1)Thent=number(j+1)number(j+1)=number(j)number(j)=tEndIfNextjNextiFori=1To20Printnumber(i)NextiEndsub首先定义一个数组：通过循环录入10个整数，然后用一个二重循环测试前一个数是否大于后一个数。如果大于则交换两个数的下标，即交换两个数在数组中的位置，交换通过一个变量来进行。我先用传统的方法解决这个问题，经过比较，选用了较为简单的和高效的排序方法——“快速排序”，具体算法可参考数据结构等有关 书 关于书的成语关于读书的排比句社区图书漂流公约怎么写关于读书的小报汉书pdf 籍。对所有数据排序后再合并相同数据，合并程序较为简便，我开始时采用了这种方法，但后来发现对于这些的数据，先合并后排序速度更快，因为有大量相同的数据。合并是采用“标记”算法，具体如下：（设数据已存放在sData()数组中，结果存到Queryp()数组，Amount是数据个数）'把相同元素置0Fori=1ToAmountIfsData(i)0ThenForj=i＋1ToAmountIfsData(i)=sData(j)ThensData(j)=0NextjEndIfNexti'删除相同元素Queryp(1)=sData(1)k=1Fori=2ToAmountIfNot(sData(i)=0)Thenk=k＋1Queryp(k)=sData(i)EndIfNextikMax=kReDimPreserveQueryp(kMax)虽然这样使得运算速度有所高，但是仍然要进行大量的循环运算，占据了程序大部分的运算时间。于是我一直在寻觅一种更为高效的算法。功夫不负有心人，在仔细分析数据的特征，比较了多种 方案 气瓶 现场处置方案 .pdf气瓶 现场处置方案 .doc见习基地管理方案.doc关于群访事件的化解方案建筑工地扬尘治理专项方案下载 之后，我终于找到了一种相当成功的算法，原来要3到4秒的运算缩短到仅需0.1到0.2秒。我遇到的数据具有以下特征：①相同数据很多，②最大、最小数之间相差不到3，③都是带两位小数的正数。针对数据的特征，我采用了以下算法：针对数据的特征，我采用了以下算法：步骤：1．用一个循环找出整数和小数部分的最大、最小值。小数部分的最大、最小值乘以100转为整数。2．定义一个二维数组，下标范围分别是整数和小数部分的最小值到最大值。3．再用一个循环把所有源数据填入刚才定义的二维数组，填写规则是，源数据的整数和小数部分分别对应二维数组的两个下标。例如，“13.51"填到“A(13,51)"中。4．最后顺向或逆向读取二维数组中的非零数据即可得到从小到大或从大到小排列的数据，而且不会含有重复数据。用VB编写的程序如下：'＊＊＊＊密集型数据处理＊＊＊＊DimiAsLong,jAsLong,kAsLong,kMaxAsLongDimQueryp()AsSingleReDimQueryp(Amount)DimIntegerPartAsInteger,DecimalPartAsIntegerDimIPmaxAsInteger,IPminAsIntegerDimDPmaxAsInteger,DPminAsIntegerDimDiffDataArray()'读取数据ReadDataIPmax=0:IPmin=1000DPmax=0:DPmin=99Fori=1ToAmount'找整数和小数部分的最大、最小值IntegerPart=Int(sData(i))DecimalPart=(sData(i)－IntegerPart)＊100IfIntegerPart>IPmaxThenIPmax=IntegerPartElseIfIntegerPartDPmaxThenDPmax=DecimalPartElseIfDecimalPart0Thenk=k＋1Queryp(k)=DiffDataArray(i,j)EndIfNextjNextikMax=kReDimPreserveQueryp(kMax)该方法对于本人遇到的这种“密集型”数据最为有效，但是如果遇上“稀疏型”数据，例如最大、最小值相差几千，甚至上万的数据，就没什么优势了，而且会占用较大的内存。经过改进，我得到了处理稀疏型数据的高效算法。高效的前提条件同样是源数据具有大量相同数据。思路是在前一种方法的基础上增加一个单维数组，用来保存整数部分数据，保存过程中用插入法对其进行排序。因为有大量重复数据，要排序的数据量相对较少。当从二维数组中读取数据时，用单维数组代入二维数组的第一个下标，具体代码下：'＊＊＊＊稀疏型数据处理＊＊＊＊DimiAsLong,jAsLong,kAsLong,kMaxAsLongDimQueryp()AsSingleReDimQueryp(Amount)DimIntegerPartAsInteger,DecimalPartAsIntegerDimIPmaxAsInteger,IPminAsIntegerDimDPmaxAsInteger,DPminAsIntegerDimIPArray()AsInteger,IPAamountAsIntegerReDimIPArray(Amount)DimDiffDataArray()'读取数据ReadDataIPmax=0:IPmin=1000DPmax=0:DPmin=99IPAamount=0Fori=1ToAmount'获取整数和小数部分的最大最小值IntegerPart=Int(sData(i))DecimalPart=(sData(i)－IntegerPart)＊100IfIntegerPart>IPmaxThenIPmax=IntegerPartElseIfIntegerPartDPmaxThenDPmax=DecimalPartElseIfDecimalPartIPArray(j)ThenIPAamount=IPAamount＋1Fork=IPAamountToj＋1Step－1IPArray(k)=IPArray(k－1)NextkIPArray(j)=IntegerPartExitForElseIfIntegerPart=IPArray(j)ThenExitForEndIfNextjIfj>IPAamountThenIPAamount=IPAamount＋1IPArray(IPAamount)=IntegerPartEndIfNextiReDimDiffDataArray(IPminToIPmax,DPminToDPmax)'填入数据Fori=1ToAmountIntegerPart=Int(sData(i))DecimalPart=(sData(i)－IntegerPart)＊100DiffDataArray(IntegerPart,DecimalPart)=sData(i)Nexti'提取数据k=0Fori=1ToIPAamountForj=DPmaxToDPminStep－1IfDiffDataArray(IPArray(i),j)0Thenk=k＋1Queryp(k)=DiffDataArray(IPArray（i),j)EndIfNextjNextikMax=kReDimPreserveQueryp(kMax)kReDimPreserveQueryp(kMax)自动隐藏表格中无数据的行表1是数据源，经常改变；表2引用表1中某列有数据的单元格（利用动态位址已实现。）由于表1的改变，表2的大小随之而变。问题：如何实现表2中没有数据的行（有公式）自动隐藏？谢谢赐教！Subabc()Fori=1To300IfCells(i,1).value=""ThenRows(i).Hidden=TrueNextiEndSub你写的语句可以解决隐藏的问题，可是如果我执行了它之后，再在表1中增加数据，表2不会自动显示有了数据的行。如何修改？将此宏设为自动运行（打开文件时）Subabc()Fori=1To300IfCells(i,1).value""ThenRows(i).Hidden=falseNextiEndSub用VBA如何自动合并列的内容？用VBA如何自动合并列的内容？Tohongjian：SubMergeTest()Fori=3To30Cells(i,3)=Cells(i,1)&Chr(10)&Cells(i,2)NextEndSub1）创建Excel对象Excel对象模型包括了128个不同的对象，从矩形、文本框等简单的对象到透视表，图表等复杂的对象。下面简单介绍一下其中最重要，也是用得最多的五个对象。（1）Application对象Application对象处于Excel对象层次结构的顶层，表示Excel自身的运行环境。（2）Workbook对象Workbook对象直接地处于Application对象的下层，表示一个Excel工作薄文件。（3）Worksheet对象Worksheet对象包含于Workbook对象，表示一个Excel工作表。（4）Range对象Range对象包含于Worksheet对象，表示Excel工作表中的一个或多个单元格。（5）Cells对象Cells对象包含于Worksheet对象，表示Excel工作表中的一个单元格。如果要启动一个Excel，使用Workbook和Worksheet对象，下面的代码启动了Excel并创建了一个新的包含一个工作表的工作薄：DimzsbexcelAsExcel.ApplicationSetzsbexcel=NewExcel.Applicationzsbexcel.Visible=True如要Excel不可见，可使zsbexcel.Visible=Falsezsbexcel.SheetsInNewWorkbook=1Setzsbworkbook=zsbexcel.Workbooks.Add2）设置单元格和区域值要设置一张工作表中每个单元格的值，可以使用Worksheet对象的Range属性或Cells属性。Withzsbexcel.ActiveSheet.Cells(1,2).value="100".Cells(2,2).value="200".Cells(3,2).value="=SUM(B1:B2)".Range("A3:A9")="中国人民解放军"EndWith要设置单元格或区域的字体、边框，可以利用Range对象或Cells对象的Borders属性和Font属性：Withobjexcel.ActiveSheet.Range("A2:K9").Borders　'边框设置.Line=xlBorderLine.Weight=xlThin.ColorIndex=1EndWithWithobjexcel.ActiveSheet.Range("A3:K9").Font　　'字体设置.Size=14.Bold=True.Italic=True.ColorIndex=3EndWith通过对Excel单元格和区域值的各种设置的深入了解,可以创建各种复杂、美观、满足需要的、具有自己特点的报表。3）预览及打印生成所需要的工作表后，就可以对EXCEL发出预览、打印指令了。zsbexcel.ActiveSheet.PageSetup.Orientation=xlPortrait　　'设置打印方向zsbexcel.ActiveSheet.PageSetup.PaperSize=xlPaperA4　　　'设置打印纸的打下zsbexcel.Caption="打印预览"　　　　　　　'设置预览窗口的标题zsbexcel.ActiveSheet.PrintPreview　　　　　　'打印预览zsbexcel.ActiveSheet.PrintOut　　　　　　　　'打印输出通过打印方向、打印纸张大小的设置，不断进行预览，直到满意为止，最终进行打印输出。为了在退出应用程序后EXCEL不提示用户是否保存已修改的文件,需使用如下语句：zsbexcel.DisplayAlerts=Falsezsbexcel.Quit　　　'退出EXCELzsbexcel.DisplayAlerts=True如此 设计 领导形象设计圆作业设计ao工艺污水处理厂设计附属工程施工组织设计清扫机器人结构设计 的报表打印是通过EXCEL程序来后台实现的。对于使用者来说，根本看不到具体过程，只看到一张张漂亮的报表轻易地被打印出来了。4）具体实例下面给出一个具体实例，它在window98、VisualBasic6.0、MicrosoftOffice97的环境下调试通过。在VB中启动一个新的StandardEXE 工程 路基工程安全技术交底工程项目施工成本控制工程量增项单年度零星工程技术标正投影法基本原理 ，在“工程”菜单的“引用”选项下引用ExcelObjectLibrary；然后在Form中添加一个命令按钮cmdExcel；最后在窗体中输入如下代码：DimzsbexcelAsExcel.ApplicationPrivateSubcmdExcel_Click()Setzsbexcel=NewExcel.Applicationzsbexcel.Visible=Truezsbexcel.SheetsInNewWorkbook=1Setzsbworkbook=zsbexcel.Workbooks.AddWithzsbexcel.ActiveSheet.Range("A2:C9").Borders　　　'边框设置.Line=xlBorderLine.Weight=xlThin.ColorIndex=1EndWithWithzsbexcel.ActiveSheet.Range("A3:C9").Font　　'字体设置.Size=14.Bold=True.Ital