| 導購 | 订阅 | 在线投稿
分享
 
 
當前位置: 王朝網路 >> vb >> 各種Excel VBA的命令1
 

各種Excel VBA的命令1

2008-09-02 06:53:53  編輯來源:互聯網  简体版  手機版  評論  字體: ||
 
 
  本示例爲設置工作表密碼

  ActiveSheet.Protect Password:=641112 ' 保護工作表並設置密碼

  ActiveSheet.Unprotect Password:=641112 '撤消工作表保護並取消密碼

  '本示例保存當前活動工作簿的副本。

  ActiveWorkbook.SaveCopyAs "C:\TEMP\XXXX.XLS"

  '本示例通過將 Saved 屬性設爲 True 來關閉包含本段代碼的工作簿,並放棄對該

  工作簿的任何更改。

  ThisWorkbook.Saved = True

  ThisWorkbook.Close

  '本示例對自動重新計算功能進行設置,使 Microsoft Excel 不對第一張工作表自

  動進行重新計算。

  Worksheets(1).EnableCalculation = False

  '下述過程打開 C 盤上名爲 MyFolder 的文件夾中的 MyBook.xls 工作簿。

  Workbooks.Open ("C:\MyFolder\MyBook.xls")

  '本示例顯示活動工作簿中工作表 sheet1 上單元格 A1 中的值。

  MsgBox Worksheets("Sheet1").Range("A1").Value

  本示例顯示活動工作簿中每個工作表的名稱

  For Each ws In Worksheets

  MsgBox ws.Name

  Next ws

  本示例向活動工作簿添加新工作表 , 並設置該工作表的名稱?

  Set NewSheet = Worksheets.Add

  NewSheet.Name = "current Budget"

  本示例將新建的工作表移到工作簿的末尾

  'Private Sub Workbook_NewSheet(ByVal Sh As Object)

  Sh.Move After:=Sheets(Sheets.Count)

  End Sub

  本示例將新建工作表移到工作簿的末尾

  'Private Sub App_WorkbookNewSheet(ByVal Wb As Workbook, _

  ByVal Sh As Object)

  Sh.Move After:=Wb.Sheets(Wb.Sheets.Count)

  End Sub

  本示例新建一張工作表,然後在第一列中列出活動工作簿中的所有工作表的名稱。

  Set NewSheet = Sheets.Add(Type:=xlWorksheet)

  For i = 1 To Sheets.Count

  NewSheet.Cells(i, 1).Value = Sheets(i).Name

  Next i

  本示例將第十行移到窗口的最上面?

  Worksheets("Sheet1").Activate

  ActiveWindow.ScrollRow = 10

  當計算工作簿中的任何工作表時,本示例對第一張工作表的 A1:A100 區域進行排序

  。

  'Private Sub Workbook_SheetCalculate(ByVal Sh As Object)

  With Worksheets(1)

  .Range("a1:a100").Sort Key1:=.Range("a1")

  End With

  End Sub

  本示例顯示工作表 Sheet1 的打印預覽。

  Worksheets("Sheet1").PrintPreview

  本示例保存當前活動工作簿?

  ActiveWorkbook.Save

  本示例保存所有打開的工作簿,然後關閉 Microsoft Excel。

  For Each w In Application.Workbooks

  w.Save

  Next w

  Application.Quit

  下例在活動工作簿的第一張工作表前面添加兩張新的工作表?

  Worksheets.Add Count:=2, Before:=Sheets(1)

  本示例設置 15 秒後運行 my_Procedure 過程,從現在開始計時。

  Application.OnTime Now + TimeValue("00:00:15"), "my_Procedure"

  本示例設置 my_Procedure 在下午 5 點開始運行。

  Application.OnTime TimeValue("17:00:00"), "my_Procedure"

  本示例撤消前一個示例對 OnTime 的設置。

  Application.OnTime EarliestTime:=TimeValue("17:00:00"), _

  Procedure:="my_Procedure", Schedule:=False

  每當工作表重新計算時,本示例就調整 A 列到 F 列的寬度。

  'Private Sub Worksheet_Calculate()

  Columns("A:F").AutoFit

  End Sub

  本示例使活動工作簿中的計算僅使用顯示的數字精度。

  ActiveWorkbook.PrecisionAsDisplayed = True

  本示例將工作表 Sheet1 上的 A1:G37 區域剪下,並放入剪貼板。

  Worksheets("Sheet1").Range("A1:G37").Cut

  Calculate 方法

  計算所有打開的工作簿、工作簿中的一張特定的工作表或者工作表中指定區域的單元

  格,如下表所示:

  '要計算 '依照本示例

  所有打開的工作簿 ' Application.Calculate (或只是 Calculate

  )

  指定工作表 '計算指定工作表Sheet1 Worksheets

  ("Sheet1").Calculate

  指定區域 'Worksheets(1).Rows(2).Calculate

  本示例對自動重新計算功能進行設置,使 Microsoft Excel 不對第一張工作表自動

  進行重新計算。

  Worksheets(1).EnableCalculation = False

  本示例計算 Sheet1 已用區域中 A 列、B 列和 C 列的公式。

  Worksheets("Sheet1").UsedRange.Columns("A:C").Calculate

  本示例更新當前活動工作簿中的所有鏈接?

  ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources

  本示例設置第一張工作表的滾動區域?

  Worksheets(1).ScrollArea = "a1:f10"

  本示例新建一個工作簿,提示用戶輸入文件名,然後保存該工作簿。

  Set NewBook = Workbooks.Add

  Do

  fName = Application.GetSaveAsFilename

  Loop Until fName False

  NewBook.SaveAs Filename:=fName

  本示例打開 Analysis.xls 工作簿,然後運行 Auto_Open 宏。

  Workbooks.Open "ANALYSIS.XLS"

  ActiveWorkbook.RunAutoMacros xlAutoOpen

  本示例對活動工作簿運行 Auto_Close 宏,然後關閉該工作簿。

  With ActiveWorkbook

  .RunAutoMacros xlAutoClose

  .Close

  End With

  在本示例中,Microsoft Excel 向用戶顯示活動工作簿的路徑和文件名稱。

  'Sub UseCanonical()

  Display the full path to user.

  MsgBox ActiveWorkbook.FullNameURLEncoded

  End Sub

  本示例顯示當前工作簿的路徑及文件名(假定尚未保存此工作簿)。

  MsgBox ActiveWorkbook.FullName

  本示例關閉 Book1.xls,並放棄所有對此工作簿的更改。

  Workbooks("BOOK1.XLS").Close SaveChanges:=False

  本示例關閉所有打開的工作簿。如果某個打開的工作簿有改變,Microsoft Excel

  將顯示詢問是否保存更改的對話框和相應提示。

  Workbooks.Close

  本示例在打印之前對當前活動工作簿的所有工作表重新計算?

  'Private Sub Workbook_BeforePrint(Cancel As Boolean)

  For Each wk In Worksheets

  wk.Calculate

  Next

  End Sub

  本示例對查詢表一中的第一列數據進行彙總,並在數據區域下方顯示第一列數據的總

  和。

  Set c1 = Sheets("sheet1").QueryTables(1).ResultRange.Columns(1)

  c1.Name = "Column1"

  c1.End(xlDown).Offset(2, 0).Formula = "=sum(Column1)"

  本示例取消活動工作簿中的所有更改?

  ActiveWorkbook.RejectAllChanges

  本示例在商業問題中使用規劃求解函數,以使總利潤達到最大值。SolverSave 函數

  將當前問題保存到活動工作表上的某一區域。

  Worksheets("Sheet1").Activate

  SolverReset

  SolverOptions Precision:=0.001

  SolverOK SetCell:=Range("TotalProfit"), _

  MaxMinVal:=1, _

  ByChange:=Range("C4:E6")

  SolverAdd CellRef:=Range("F4:F6"), _

  Relation:=1, _

  FormulaText:=100

  SolverAdd CellRef:=Range("C4:E6"), _

  Relation:=3, _

  FormulaText:=0

  SolverAdd CellRef:=Range("C4:E6"), _

  Relation:=4

  SolverSolve UserFinish:=False

  SolverSave SaveArea:=Range("A33")

  本示例隱藏 Chart1、Chart3 和 Chart5。

  Charts(Array("Chart1", "Chart3", "Chart5")).Visible = False

  當激活工作表時,本示例對 A1:A10 區域進行排序。

  'Private Sub Worksheet_Activate()

  Range("a1:a10").Sort Key1:=Range("a1"), Order:=xlAscending

  End Sub

  本示例更改 Microsoft Excel 鏈接。

  ActiveWorkbook.ChangeLink "c:\excel\book1.xls", _

  "c:\excel\book2.xls", xlExcelLinks

  本示例啓用受保護的工作表上的自動篩選箭頭?

  ActiveSheet.EnableAutoFilter = True

  ActiveSheet.Protect contents:=True, userInterfaceOnly:=True

  本示例將活動工作簿設爲只讀?

  ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly

  本示例使共享工作簿每三分鍾自動更新一次?

  ActiveWorkbook.AutoUpdateFrequency = 3

  下述 Sub 過程清除活動工作簿中 Sheet1 上的所有單元格的內容。

  'Sub ClearSheet()

  Worksheets("Sheet1").Cells.ClearContents

  End Sub

  本示例對所有工作簿都關閉滾動條?

  Application.DisplayScrollBars = False

  如果具有密碼保護的工作簿的文件屬性沒有加密,則本示例設置指定工作簿的密碼加

  密選項。

  'Sub SetPasswordOptions()

  With ActiveWorkbook

  If .PasswordEncryptionProvider "Microsoft RSA SChannel

  Cryptographic Provider" Then

  .SetPasswordEncryptionOptions _

  PasswordEncryptionProvider:="Microsoft RSA SChannel

  Cryptographic Provider", _

  PasswordEncryptionAlgorithm:="RC4", _

  PasswordEncryptionKeyLength:=56, _

  PasswordEncryptionFileProperties:=True

  End If

  End With

  End Sub

  在本示例中,如果活動工作簿不能進行寫保護,那麽 Microsoft Excel 設置字符串

  密碼以作爲活動工作簿的寫密碼。

  'Sub UseWritePassword()

  Dim strPassword As String

  strPassword = "secret"

  ' Set password to a string if allowed.

  If ActiveWorkbook.WriteReserved = False Then

  ActiveWorkbook.WritePassword = strPassword

  End If

  End Sub

  在本示例中,Microsoft Excel 打開名爲 Password.xls 的工作簿,設置它的密碼

  ,然後關閉該工作簿。本示例假定名爲 Password.xls 的文件位于 C:\ 驅動器上。

  'Sub UsePassword()

  Dim wkbOne As Workbook

  Set wkbOne = Application.Workbooks.Open("C:\Password.xls")

  wkbOne.Password = "secret"

  wkbOne.Close

  '注意 Password 屬性可讀並返回 「********」。

  End Sub

  本示例將 Book1.xls 的當前窗口更改爲顯示公式。

  Workbooks("BOOK1.XLS").Worksheets("Sheet1").Activate

  ActiveWindow.DisplayFormulas = True

  '本示例接受活動工作簿中的所有更改?

  ActiveWorkbook.AcceptAllChanges

  本示例顯示活動工作簿的路徑和名稱

  Sub UseCanonical()

  MsgBox '消息框

  [b7] = ActiveWorkbook.FullName '當前工作簿

  [b8] = ActiveWorkbook.FullNameURLEncoded '活動工作簿

  End Sub

  本示例顯示 Microsoft Excel 啓動文件夾的完整路徑。

  MsgBox Application.StartupPath

  Activate 事件

  激活一個工作簿、工作表、圖表或嵌入圖表時産生此事件。

  當激活工作表時,本示例對 A1:A10 區域進行排序。

  Private Sub Worksheet_Activate()

  Range("a1:a10").Sort Key1:=Range("a1"), Order:=xlAscending

  End Sub

  Calculate 事件

  對于 Worksheet 對象,在對工作表進行重新計算之後産生此事件

  每當工作表重新計算時,本示例就調整 A 列到 F 列的寬度。

  Private Sub Worksheet_Calculate()

  Columns("A:F").AutoFit

  End Sub

  本示例向活動工作簿添加新工作表,並設置該工作表的名稱。

  Set newSheet = Worksheets.Add

  newSheet.Name = "current Budget"

  本示例關閉工作簿 Book1.xls,但不提示用戶保存所作更改。Book1.xls 中的所有

  更改都不會保存。

  Application.DisplayAlerts = False

  Workbooks("BOOK1.XLS").Close

  Application.DisplayAlerts = True

  示例顯示每一個可用加載宏的路徑及文件名。

  For Each a In AddIns

  MsgBox a.FullName

  Next a

  ChDir 語句

  改變當前的目錄或文件夾。

  ChDir path

  在 Power Macintosh 中,默認驅動器總是改爲在 path 語句中指定的驅動器。完整

  路徑指定由卷標名開始,相對路徑由冒號 (:) 開始. ChDir 可以辨認路徑中指定的

  別名:

  ChDir "MacDrive:Tmp" ' 在 Macintosh 中

  本示例顯示當前路徑分隔符。

  MsgBox "The path separator character is " & _

  Application.PathSeparator

  Move 方法

  將一個指定的文件或文件夾從一個地方移動到另一個地方。

  語法

  object.Move destination

  Move 方法語法有如下幾部分:

  部分 描述

  object 必需的。始終是一個 File 或 Folder 對象的名字。

  destination 必需的。文件或文件夾要移動到的目標。不允許有通配符。

  CreateFolder 方法

  創建一個文件夾。

  語法

  object.CreateFolder(foldername)

  reateFolder 方法有如下幾部分:

  部分 描述

  object 必需的。始終是一個 FileSystemObject 的名字。

  foldername 必需的。字符串表達式,它標識創建的文件夾。

  本示例使用 MkDir 語句來創建目錄或文件夾。如果沒有指定驅動器,新目錄或文件

  夾將會建在當前驅動器中。

  MkDir "MYDIR" ' 建立新的目錄或文件夾。

  Name 語句示例

  本示例使用 Name 語句來更改文件的名稱。示例中假設所有使用到的目錄或文件夾都

  已存在。 在 Macintosh 中,默認驅動器名稱是 「HD」 並且路徑部分由冒號取代

  反斜線隔開。

  Dim OldName, NewName

  OldName = "OLDFILE": NewName = "NEWFILE" ' 定義文件名。

  Name OldName As NewName ' 更改文件名。

  OldName = "C:\MYDIR\OLDFILE": NewName = "C:\YOURDIR\NEWFILE"

  Name OldName As NewName ' 更改文件名,並移動文件。

  本示例設置替換啓動文件夾。

  Application.AltStartupPath = "C:\EXCEL\MACROS"

  FolderExists 方法

  如果指定的文件夾存在返回 True,不存在返回 False。

  語法

  object.FolderExists(folderspec)

  本示例在單元格中啓用編輯。

  Application.EditDirectlyInCell = True

  程序說明:

  幾種用VBA在單元格輸入數據的方法:

  Public Sub Writes()

  1-- 2 方法,最簡單在 "[ ]" 中輸入單元格名稱。

  1 [A1] = 100 '在 A1 單元格輸入100。

  2 [A2:A4] = 10 '在 A2:A4 單元格輸入10。

  3-- 4 方法,采用 Range(" "), " " 中輸入單元格名稱。

  3 Range("B1") = 200 '在 B1 單元格輸入200。

  4 Range("C1:C3") = 300 '在 C1:C3 單元格輸入300。

  5-- 6 方法,采用 Cells(Row,Column),Row是單元格行數,Column是單元格欄數。

  5 Cells(1, 4) = 400 '在 D1 單元格輸入400。

  6 Range(Cells(1, 5), Cells(5, 5)) = 50 '在 E1:E 5單元格輸入50。

  End Sub

  VBALesson3 程序說明:

  如何利用 Worksheet_SelectionChange 輸入數據的方法。

  Private Sub Worksheet_SelectionChange(ByVal Target As Range)

  Target = 100

  End Sub

  VBALesson4 程序說明:

  如何利用 Worksheet_SelectionChange 在限定的單元格輸入數據的方法。

  Private Sub Worksheet_SelectionChange(ByVal Target As Range)

  If Target.Row >= 2 And Target.Column = 2 Then

  Target = 100

  End If

  End Sub

  VBALesson5 程序說明:

  比較 Worksheet_SelectionChange() 與用按鈕 CommandButton1_Click() 來執行

  程序二者的方法與寫法有何不同。

  Worksheet_SelectionChange()事件

  Private Sub Worksheet_SelectionChange(ByVal Target As Range)

  If Target.Row >= 2 And Target.Column = 2 Then

  Target = 100

  End If

  End Sub

  按鈕 CommandButton1_Click()

  Private Sub CommandButton1_Click()

  If ActiveCell.Row >= 2 And ActiveCell.Column >= 3 Then

  ActiveCell = 100

  End If

  End Sub

  二者執行方法最大的地方,在于 Worksheet_SelectionChange() 是自動的,你不用

  了解他是怎麽完成工作的。

  按鈕 CommandButton1_Click() 是人工的,比 SelectionChange()多一道手續,

  就是要去按那接鈕,程序才會執行。

  SelectionChange() 有一個參數 Target 可用;CommandButton1_Click ()沒有。

  所以我們要用 ActiveCell 內定函數來取代Target,ActiveCell 與 Target最大的

  不同點他只能指定一個單元格。

  就是你選取多個單元格也只有最上面的單元格會加上數據;用 Selection 取代

  ActiveCell, 用法就跟 Target 一樣了。

  VBALesson 6 程序說明:

  完整的 If...Then ┅ End 邏輯判斷式。

  Private Sub Worksheet_SelectionChange(ByVal Target As Range)

  If Target.Row >= 2 And Target.Column = 2 Then

  Target = 200

  ElseIf Target.Row >= 2 And Target.Column = 3 Then

  Target = 300

  ElseIf Target.Row >= 2 And Target.Column = 2 Then

  Target = 400

  Else

  Target = 500

  End If

  End Sub

  這是個完整的 If 邏輯判斷式,意思是說,假如 If 後的判斷式條件成立的話,就

  執行第二條程序,否則假如 ElseIf 後的判斷式條件成立的話,就執行第四條程序

  ,否則假如另一個 ElseIf 後的判斷式條件成立的話,就執行第六條程序。

  Else 的意思是說,假如以上條件都不成立的話,就執行第八條程序。

  他的執行方式是假如 IF 的條件成立的話,就不執行其它ElseIf 及Else 的邏輯判

  斷式,假如 If 後的條件不成立的話才會執行 ElseIf 或 Else 邏輯判斷式。第二

  個 ElseIf後的條件因爲與 IF 後的條件一樣,所以這個判斷式後面的 Target=400

  將是永遠無法執行到的程序。

  VBALesson 7 程序說明∶我們爲什麽要用變數。

  Private Sub Worksheet_SelectionChange(ByVal Target As Range)

  Dim i , j As Integer

  Dim k As Range

  i = Target.Row

  j = Target.Column

  Set k = Target

  If i >= 2 And j = 2 Then

  k = 200

  ElseIf i >= 2 And j = 3 Then

  k = 300

  ElseIf i >= 2 And j = 4 Then

  k = 400

  Else

  k = 500

  End If

  End Sub

  Private Sub Worksheet_Change(ByVal Target As Range)

  Dim iRow, iCol As Integer

  iRow = Target.Row

  iCol = Target.Column

  If iRow >= 2 And iCol = 2 And Target "" Then

  Application.EnableEvents = False

  Cells(iRow, iCol + 1) = Cells(iRow, iCol) * 2

  Application.EnableEvents = True

  ElseIf iRow >= 2 And iCol = 2 And Target = "" Then

  Cells(iRow, iCol + 1) = ""

  Else

  Cells(iRow, iCol + 1) = ""

  End If

  End Sub

  前幾個教程都是用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()事件。

  VBALesson 9 程序說明∶體會一下Worksheet_Change()事件連鎖反應。

  Private Sub Worksheet_Change(ByVal Target As Range)

  Dim iRow As Integer

  iRow = Target.Row

  Application.EnableEvents = False

  Cells(iRow, 3) = Cells(iRow, 3) + Cells(iRow, 2)

  Application.EnableEvents = True

  End Sub

  Private Sub Worksheet_Change(ByVal Target As Range)

  Dim iRow As Integer

  iRow = Target.Row

  'Application.EnableEvents = False

  Cells(iRow, 3) = Cells(iRow, 3) + Cells(iRow, 2)

  'Application.EnableEvents = True

  End Sub

  這個程序的目的是要在 B2 輸入新的數?時,C2 會將 B2 輸入的新數?加上 C2 原

  有的數?呈現在 C2 上。

  照上面有加上 Application.EnableEvents = False 程序執行當然沒問題。

  現在你在 Application.EnableEvents = False 與 Application.EnableEvents =

  True 前加上「 '」看看。

  程序前加上「 '」的目的是要使「 '」之後的文字變成說明文字,程序執行時是會跳

  過說明文字,不執行說明文字的內容。

  程序前加上「 '」符號後,文字會變成綠色。

  執行第二個程序時,你將發現 C2 不會按你所要求的,呈現結果。

  這就是所謂的事件連鎖反應。

  請問這個宏該如何寫!

  我想運行一個宏,就能在當前工作表B3上填上一條公式;這條公式的結果是所有工作

  表上的B4單元格的和.請問這個宏該如何寫.謝謝!

  Sub gg()

  Dim sh As Worksheet, shname$

  For Each sh In Worksheets

  shname = sh.Name

  ActiveSheet.Range("b3").value = ActiveSheet.Range("b3").value +

  Worksheets(shname).Range("b4")

  Next

  End Sub

  VBA中怎樣創建一個名爲「table」的新工作表

  通過VBA編程,很容易添加新的工作表,但是新表的名字不知怎樣控制,對于新創建

  的工作表,由于其名字並非特定,所以就不好使用所創建的新表了。不知各位有何高

  見。。。。

  Sheets.Add

  ActiveSheet.Name = "table"

  請教:如何用VBA檢索表1中A列與表2,3,4,5.....中A列相同的行並把後者整行拷

  貝到表1檢索到的行中,謝謝!!!!

  To yxptwq∶用這程序試看看。

  Sub Copy1()

  Dim Row_dn1, Row_dnN, i, j, n As Integer

  Row_dn1 = Sheet1.Range("A65536").End(xlUp).Row

  k = 1: n = 1

  For Each wSheet In ActiveWorkbook.Worksheets

  With wSheet

  If .Name "Sheet1" Then

  Row_dnN = .Range("A65536").End(xlUp).Row

  For i = 2 To Row_dn1

  For j = 2 To Row_dnN

  If .Cells(j, 1) = Sheet1.Cells(i, 1) Then

  .Rows(j & ":" & j).Copy Destination:=Sheet1.Rows(Row_dn1 +

  n & ":" & Row_dn1 + n)

  n = n + 1

  End If

  Next j

  Next i

  End If

  End With

  Next wSheet

  End Sub

  如果要用VBA程式輸入密碼使用下列程式碼

  Sub EnterNewPW()

  '程式說明:利用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 鍵(跳到第一次輸入密碼

  Textbox

  myPW = "chijanzen" '假設密碼 chijanzen

  Application.SendKeys myPW, True '輸入密碼

  Application.SendKeys "{TAB}", True 'TAB 鍵(跳到第二次輸入密碼

  Textbox

  Application.SendKeys myPW, True '輸入密碼

  Application.SendKeys "{ENTER}", True '按確定鈕(預設值)

  Application.SendKeys "%{F11}", True '返回Excel視窗

  End Sub

  冒泡排序法:

  冒泡排序法之所以成爲「冒泡排序」是因爲值較小的或是較輕的元素浮到作爲繼續排

  序的一組數的頂部。

  Sub Macro1()

  Dim i As Integer

  Dim j As Integer

  Dim t as integer

  Static number(1 To 10) As Integer

  For i = 1 To 10

  number(i) = inputbox「輸入要排序的數:」

  Next i

  For i = 10To 2 Step -1

  For j = 1 To i – 1

  『下面進行位置交換

  If number(j) > number(j + 1) Then

  t = number(j + 1)

  number(j + 1) = number(j)

  number(j) = t

  End If

  Next j

  Next i

  For i = 1 To 20

  Print number(i)

  Next i

  End sub

  首先定義一個數組:通過循環錄入10個整數,然後用一個二重循環測試前一個數是否

  大于後一個數。如果大于則交換兩個數的下標,即交換兩個數在數組中的位置,交換

  通過一個變量來進行。

  我先用傳統的方法解決這個問題,經過比較,選用了較爲簡單的和高效的排序方法

  ——「快速排序」,具體算法可參考數據結構等有關書籍。對所有數據排序後再合

  並相同數據,合並程序較爲簡便,我開始時采用了這種方法,但後來發現對于這些

  的數據,先合並後排序速度更快,因爲有大量相同的數據。合並是采用「標記」算

  法,具體如下:(設數據已存放在sData()數組中 ,結果存到Queryp()數組,

  Amount是數據個數)

  '把相同元素置 0

  For i = 1 To Amount

  If sData(i) 0 Then

  For j = i + 1 To Amount

  If sData(i) = sData(j) Then sData(j) = 0

  Next j

  End If

  Next i

  '刪除相同元素

  Queryp(1) = sData(1)

  k = 1

  For i = 2 To Amount

  If Not (sData(i) = 0) Then

  k = k + 1

  Queryp(k) = sData(i)

  End If

  Next i

  kMax = k

  ReDim Preserve Queryp(kMax)

  雖然這樣使得運算速度有所高,但是仍然要進行大量的循環運算,占據了程序大部

  分的運算時間。于是我一直在尋覓一種更爲高效的算法。

  功夫不負有心人,在仔細分析數據的特征,比較了多種方案之後,我終于找到了一

  種相當成功的算法,原來要3到4秒的運算縮短到僅需0.1到0.2秒。

  我遇到的數據具有以下特征:①相同數據很多,②最大、最小數之間相差不到3,

  ③都是帶兩位小數的正數。

  針對數據的特征,我采用了以下算法:

  針對數據的特征,我采用了以下算法:

  步驟:

  1. 用一個循環找出整數和小數部分的最大、最小值。小數部分的最大、最小值乘

  以100轉爲整數。

  2. 定義一個二維數組,下標範圍分別是整數和小數部分的最小值到最大值。

  3. 再用一個循環把所有源數據填入剛才定義的二維數組,填寫規則是,源數據的

  整數和小數部分分別對應二維數組的兩個下標。例如,「13.51"填到「A(13,51)"

  中。

  4. 最後順向或逆向讀取二維數組中的非零數據即可得到從小到大或從大到小排列

  的數據,而且不會含有重複數據。

  用VB 編寫的程序如下:

  '****密集型數據處理****

  Dim i As Long, j As Long, k As Long, kMax As Long

  Dim Queryp() As Single

  ReDim Queryp(Amount)

  Dim IntegerPart As Integer, DecimalPart As Integer

  Dim IPmax As Integer, IPmin As Integer

  Dim DPmax As Integer, DPmin As Integer

  Dim DiffDataArray()

  '讀取數據

  ReadData

  IPmax = 0: IPmin = 1000

  DPmax = 0: DPmin = 99

  For i = 1 To Amount

  ' 找整數和小數部分的最大、最小值

  IntegerPart = Int(sData(i))

  DecimalPart = (sData(i) - IntegerPart) * 100

  If IntegerPart > IPmax Then

  IPmax = IntegerPart

  ElseIf IntegerPart DPmax Then

  DPmax = DecimalPart

  ElseIf DecimalPart 0 Then

  k = k + 1

  Queryp(k) = DiffDataArray(i, j)

  End If

  Next j

  Next i

  kMax = k

  ReDim Preserve Queryp(kMax)

  該方法對于本人遇到的這種「密集型」數據最爲有效,但是如果遇上「稀疏型」數

  據,例如最大、最小值相差幾千,甚至上萬的數據,就沒什麽優勢了,而且會占用

  較大的內存。

  經過改進,我得到了處理稀疏型數據的高效算法。高效的前提條件同樣是源數據具

  有大量相同數據。思路是在前一種方法的基礎上增加一個單維數組,用來保存整數

  部分數據,保存過程中用插入法對其進行排序。因爲有大量重複數據,要排序的數

  據量相對較少。當從二維數組中讀取數據時,用單維數組代入二維數組的第一個下

  標,具體代碼下:

  '****稀疏型數據處理****

  Dim i As Long, j As Long, k As Long, kMax As Long

  Dim Queryp() As Single

  ReDim Queryp(Amount)

  Dim IntegerPart As Integer, DecimalPart As Integer

  Dim IPmax As Integer, IPmin As Integer

  Dim DPmax As Integer, DPmin As Integer

  Dim IPArray() As Integer, IPAamount As Integer

  ReDim IPArray(Amount)

  Dim DiffDataArray()

  '讀取數據

  ReadData

  IPmax = 0: IPmin = 1000

  DPmax = 0: DPmin = 99

  IPAamount = 0

  For i = 1 To Amount

  '獲取整數和小數部分的最大最小值

  IntegerPart = Int(sData(i))

  DecimalPart = (sData(i) - IntegerPart) * 100

  If IntegerPart > IPmax Then

  IPmax = IntegerPart

  ElseIf IntegerPart DPmax Then

  DPmax = DecimalPart

  ElseIf DecimalPart IPArray(j) Then

  IPAamount = IPAamount + 1

  For k = IPAamount To j + 1 Step -1

  IPArray(k) = IPArray(k - 1)

  Next k

  IPArray(j) = IntegerPart

  Exit For

  ElseIf IntegerPart = IPArray(j) Then

  Exit For

  End If

  Next j

  If j > IPAamount Then

  IPAamount = IPAamount + 1

  IPArray(IPAamount) = IntegerPart

  End If

  Next i

  ReDim DiffDataArray(IPmin To IPmax, DPmin To DPmax)

  '填入數據

  For i = 1 To Amount

  IntegerPart = Int(sData(i))

  DecimalPart = (sData(i) - IntegerPart) * 100

  DiffDataArray(IntegerPart, DecimalPart) = sData(i)

  Next i

  '提取數據

  k = 0

  For i = 1 To IPAamount

  For j = DPmax To DPmin Step -1

  If DiffDataArray(IPArray(i), j) 0 Then

  k = k + 1

  Queryp(k) = DiffDataArray(IPArray

  (i), j)

  End If

  Next j

  Next i

  kMax = k

  ReDim Preserve Queryp(kMax)

  k

  ReDim Preserve Queryp(kMax)

  自動隱藏表格中無數據的行

  表1 是數據源,經常改變;

  表2 引用表1 中某列有數據的單元格(利用動態位址已實現。)

  由于表1 的改變,表2 的大小隨之而變。

  問題:如何實現表2 中沒有數據的行(有公式)自動隱藏?謝謝賜教!

  Sub abc()

  For i = 1 To 300

  If Cells(i, 1).value = "" Then Rows(i).Hidden = True

  Next i

  End Sub

  你寫的語句可以解決隱藏的問題,可是如果我執行了它之後,再在表1中增加數據,

  表2不會自動顯示有了數據的行。如何修改?

  將此宏設爲自動運行(打開文件時)

  Sub abc()

  For i = 1 To 300

  If Cells(i, 1).value "" Then Rows(i).Hidden = false

  Next i

  End Sub

  用VBA如何自動合並列的內容?

  用VBA如何自動合並列的內容?

  To hongjian :

  Sub MergeTest()

  For i = 3 To 30

  Cells(i, 3) = Cells(i, 1) & Chr(10) & Cells(i, 2)

  Next

  End Sub

  1)創建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並創建了一個新的包含一個工作表的工作薄:

  Dim zsbexcel As Excel.Application

  Set zsbexcel = New Excel.Application

  zsbexcel.Visible = True

  如要Excel不可見,可使zsbexcel.Visible = False

  zsbexcel.SheetsInNewWorkbook = 1

  Set zsbworkbook = zsbexcel.Workbooks.Add

  2)設置單元格和區域值

  要設置一張工作表中每個單元格的值,可以使用Worksheet對象的

  Range屬性或Cells屬性。

  With zsbexcel.ActiveSheet

  .Cells(1, 2).value = "100"

  .Cells(2, 2).value = "200"

  .Cells(3, 2).value = "=SUM(B1:B2)"

  .Range("A3:A9") = "中國人民解放軍"

  End With

  要設置單元格或區域的字體、邊框,可以利用Range對象或Cells對象

  的Borders屬性和Font屬性:

  With objexcel.ActiveSheet.Range("A2:K9").Borders '邊框設置

  .Line = xlBorderLine

  .Weight = xlThin

  .ColorIndex = 1

  End With

  With objexcel.ActiveSheet.Range("A3:K9").Font'字體設置

  .Size = 14

  .Bold = True

  .Italic = True

  .ColorIndex = 3

  End With

  通過對Excel單元格和區域值的各種設置的深入了解,可以創建各種複

  雜、美觀、滿足需要的、具有自己特點的報表。

  3)預覽及打印

  生成所需要的工作表後,就可以對EXCEL發出預覽、打印指令了。

  zsbexcel.ActiveSheet.PageSetup.Orientation = xlPortrait '

  設置打印方向

  zsbexcel.ActiveSheet.PageSetup.PaperSize = xlPaperA4'

  設置打印紙的打下

  zsbexcel.Caption = "打印預覽" '設置預覽窗口的

  標題

  zsbexcel.ActiveSheet.PrintPreview'打印預覽

  zsbexcel.ActiveSheet.PrintOut'打印輸出

  通過打印方向、打印紙張大小的設置,不斷進行預覽,直到滿意爲止,

  最終進行打印輸出。

  爲了在退出應用程序後EXCEL不提示用戶是否保存已修改的文件,需使

  用如下語句:

  zsbexcel.DisplayAlerts = False

  zsbexcel.Quit '退出EXCEL

  zsbexcel.DisplayAlerts = True

  如此設計的報表打印是通過 EXCEL程序來後台實現的。對于使用者來

  說,根本看不到具體過程,只看到一張張漂亮的報表輕易地被打印出來了。

  4)具體實例

  下面給出一個具體實例,它在window98、Visual Basic 6.0、

  Microsoft Office97的環境下調試通過。

  在VB中啓動一個新的Standard EXE工程,在「工程」菜單的「引用」

  選項下引用Excel Object Library;然後在Form中添加一個命令按鈕

  cmdExcel;最後在窗體中輸入如下代碼:

  Dim zsbexcel As Excel.Application

  Private Sub cmdExcel_Click()

  Set zsbexcel = New Excel.Application

  zsbexcel.Visible = True

  zsbexcel.SheetsInNewWorkbook = 1

  Set zsbworkbook = zsbexcel.Workbooks.Add

  With zsbexcel.ActiveSheet.Range("A2:C9").Borders'邊框設置

  .Line = xlBorderLine

  .Weight = xlThin

  .ColorIndex = 1

  End With

  With zsbexcel.ActiveSheet.Range("A3:C9").Font'字體設置

  .Size = 14

  .Bold = True

  .Italic = True

  .ColorIndex = 3

  End With

  zsbexcel.ActiveSheet.Rows.HorizontalAlignment =

  xlVAlignCenter'水平居中

  zsbexcel.ActiveSheet.Rows.VerticalAlignment =

  xlVAlignCenter'垂直居中

  With zsbexcel.ActiveSheet

  .Cells(1, 2).value = "100"

  .Cells(2, 2).value = "200"

  .Cells(3, 2).value = "=SUM(B1:B2)"

  .Cells(1, 3).value = "中國人民解放軍"

  .Range("A3:A9") = "50"

  End With

  zsbexcel.ActiveSheet.PageSetup.Orientation = xlPortrait '

  xlLandscape

  zsbexcel.ActiveSheet.PageSetup.PaperSize = xlPaperA4

  zsbexcel.ActiveSheet.PrintOut

  zsbexcel.DisplayAlerts = False

  zsbexcel.Quit

  zsbexcel.DisplayAlerts = True

  Set zsbexcel = Nothing

  提高EXCEL中VBA的效率

  方法1:盡量使用VBA原有的屬性、方法和Worksheet函數

  由于Excel對象多達百多個,對象的屬性、方法、事件多不勝數,對于初學者來

  說可能對它們不全部了解,這就産生了編程者經常編寫與Excel對象的屬性、方法相

  同功能的VBA代碼段,而這些代碼段的運行效率顯然與Excel對象的屬性、方法完成

  任務的速度相差甚大。例如用Range的屬性CurrentRegion來返回 Range 對象,該對

  象代表當前區。(當前區指以任意空白行及空白列的組合爲邊界的區域)。同樣功能

  的VBA代碼需數十行。因此編程前應盡可能多地了解Excel對象的屬性、方法。

  充分利用Worksheet函數是提高程序運行速度的極度有效的方法。如求平均工資

  的例子:For Each c In Worksheet(1).Range(″A1:A1000″)

  Totalvalue = Totalvalue + c.value

  Next

  Averagevalue = Totalvalue / Worksheet(1).Range(″

  A1:A1000″).Rows.Count

  而下面代碼程序比上面例子快得多:

  Averagevalue="/blog/Application.WorksheetFunction.Average(Worksheets

  (1).Range(″A1:A1000″))

  其它函數如Count,Counta,Countif,Match,Lookup等等,都能代替相同功能的

  VBA程序代碼,提高程序的運行速度。

  方法2:盡量減少使用對象引用,尤其在循環中

  每一個Excel對象的屬性、方法的調用都需要通過OLE接口的一個或多個調用,

  這些OLE調用都是需要時間的,減少使用對象引用能加快VBA代碼的運行。例如

  1.使用With語句。

  Workbooks(1).Sheets(1).Range(″A1:A1000″).Font.Name=″Pay″

  Workbooks(1).Sheets(1).Range(″A1:A1000″).Font.Font

  ...

  則以下語句比上面的快

  With Workbooks(1).Sheets(1).Range(″A1:A1000″).Font

  .Name = ″Pay″

  .Font = ″Bold″

  ...

  End With

  2.使用對象變量。

  如果你發現一個對象引用被多次使用,則你可以將此對象用Set 設置爲對象變

  量,以減少對對象的訪問。如:

  Workbooks(1).Sheets(1).Range(″A1″).value = 100

  Workbooks(1).Sheets(1).Range(″A2″).value = 200

  則以下代碼比上面的要快:

  Set MySheet = Workbooks(1).Sheets(1)

  MySheet.Range(″A1″).value = 100

  MySheet.Range(″A2″).value = 200

  3.在循環中要盡量減少對象的訪問。

  For k = 1 To 1000

  Sheets(″Sheet1″).Select

  Cells(k,1).value = Cells(1,1).value

  Next k

  則以下代碼比上面的要快:

  Set Thevalue = Cells(1,1).value

  Sheets(″Sheet1″).Select

  For k = 1 To 1000

  Cells(k,1).value = Thevalue

  Next k

  方法3:減少對象的激活和選擇

  如果你的通過錄制宏來學習VBA的,則你的VBA程序裏一定充滿了對象的激活和選

  擇,例如Workbooks(XXX).Activate、Sheets(XXX).Select、Range(XXX).Select等

  ,但事實上大多數情況下這些操作不是必需的。例如

  Sheets(″Sheet3″).Select

  Range(″A1″).value = 100

  Range(″A2″).value = 200

  可改爲:

  With Sheets(″Sheet3″)

  .Range(″A1″).value = 100

  .Range(″A2″).value = 200

  End With

  方法4:關閉屏幕更新

  如果你的VBA程序前面三條做得比較差,則關閉屏幕更新是提高VBA程序運行速度

  的最有效的方法,縮短運行時間2/3左右。關閉屏幕更新的方法:

  Application.ScreenUpdate = False

  請不要忘記VBA程序運行結束時再將該值設回來:

  Application.ScreenUpdate = True

  以上是提高VBA運行效率的比較有效的幾種方法
 
 
 
上一篇《各種Excel VBA的命令2》
下一篇《Excel中調用VBA選擇目標文件夾》
 
 
 
 
 
 
日版寵物情人插曲《Winding Road》歌詞

日版寵物情人2017的插曲,很帶節奏感,日語的,女生唱的。 最後聽見是在第8集的時候女主手割傷了,然後男主用嘴幫她吸了一下,插曲就出來了。 歌手:Def...

兄弟共妻,我成了他們夜裏的美食

老鍾家的兩個兒子很特別,就是跟其他的人不太一樣,魔一般的執著。兄弟倆都到了要結婚的年齡了,不管自家老爹怎麽磨破嘴皮子,兄弟倆說不娶就不娶,老父母爲兄弟兩操碎了心...

如何磨出破洞牛仔褲?牛仔褲怎麽剪破洞?

把牛仔褲磨出有線的破洞 1、具體工具就是磨腳石,下面墊一個硬物,然後用磨腳石一直磨一直磨,到把那塊磨薄了,用手撕開就好了。出來的洞啊很自然的。需要貓須的話調幾...

我就是掃描下圖得到了敬業福和愛國福

先來看下敬業福和愛國福 今年春節,支付寶再次推出了“五福紅包”活動,表示要“把欠大家的敬業福都還給大家”。 今天該活動正式啓動,和去年一樣,需要收集“五福”...

冰箱異味産生的原因和臭味去除的方法

有時候我們打開冰箱就會聞到一股異味,冰箱裏的這種異味是因爲一些物質發出的氣味的混合體,聞起來讓人惡心。 産生這些異味的主要原因有以下幾點。 1、很多人有這種習...

《極品家丁》1-31集大結局分集劇情介紹

簡介 《極品家丁》講述了現代白領林晚榮無意回到古代金陵,並追隨蕭二小姐化名“林三”進入蕭府,不料卻陰差陽錯上演了一出低級家丁拼搏上位的“林三升職記”。...

李溪芮《極品家丁》片尾曲《你就是我最愛的寶寶》歌詞

你就是我最愛的寶寶 - 李溪芮 (電視劇《極品家丁》片尾曲) 作詞:常馨內 作曲:常馨內 你的眉 又鬼馬的挑 你的嘴 又壞壞的笑 上一秒吵鬧 下...

烏梅的功效與作用以及烏梅的食用禁忌有哪些?

烏梅,又稱春梅,中醫認爲,烏梅味酸,性溫,無毒,具有安心、除熱、下氣、祛痰、止渴調中、殺蟲的功效,治肢體痛、肺痨病。烏梅泡水喝能治傷寒煩熱、止吐瀉,與幹姜一起制...

什麽是脂肪粒?如何消除臉部脂肪粒?

什麽是脂肪粒 在我們的臉上總會長一個個像脂肪的小顆粒,弄也弄不掉,而且顔色還是白白的。它既不是粉刺也不是其他的任何痘痘,它就是脂肪粒。 脂肪粒雖然也是由油脂...

網絡安全治理:國家安全保障的主要方向是打擊犯罪,而不是處置和懲罰受害者

來源:中國青年報 新的攻擊方法不斷湧現,黑客幾乎永遠占據網絡攻擊的上風,我們不可能通過技術手段杜絕網絡攻擊。國家安全保障的主要方向是打擊犯罪,而不是處置和懲罰...

河南夫妻在溫嶺網絡直播“造人”內容涉黃被刑事拘留

夫妻網絡直播“造人”爆紅   1月9日,溫嶺城北派出所接到南京警方的協查通告,他們近期打掉了一個涉黃直播APP平台。而根據掌握的線索,其中有一對涉案的夫妻主播...

如何防止牆紙老化?牆紙變舊變黃怎麽辦?

如何防止牆紙老化? (1)選擇透氣性好的牆紙 市場上牆紙的材質分無紡布的、木纖維的、PVC的、玻璃纖維基材的、布面的等,相對而言,PVC材質的牆紙最不透氣...

鮮肌之謎非日本生産VS鮮肌之謎假日貨是謠言

觀點一:破日本銷售量的“鮮肌之謎” 非日本生産 近一段時間,淘寶上架了一款名爲“鮮肌之謎的” 鲑魚卵巢美容液,號稱是最近日本的一款推出的全新護膚品,産品本身所...

中國最美古詩詞精選摘抄

系腰裙(北宋詞人 張先) 惜霜蟾照夜雲天,朦胧影、畫勾闌。人情縱似長情月,算一年年。又能得、幾番圓。 欲寄西江題葉字,流不到、五亭前。東池始有荷新綠,尚小如...

關于女人的經典語句

關于女人的經典語句1、【做一個獨立的女人】 思想獨立:有主見、有自己的人生觀、價值觀。有上進心,永遠不放棄自己的理想,做一份自己喜愛的事業,擁有快樂和成就...

未來我們可以和性愛機器人結婚嗎?

你想體驗機器人性愛嗎?你想和性愛機器人結婚嗎?如果你想,機器人有拒絕你的權利嗎? 近日,第二屆“國際人類-機器人性愛研討會”大會在倫敦金史密斯大學落下帷幕。而...

全球最變態的十個地方

10.土耳其地下洞穴城市 變態指數:★★☆☆☆ 這是土耳其卡帕多西亞的一個著名景點,傳說是當年基督教徒們爲了躲避戰爭而在此修建。裏面曾住著20000人,...

科學家稱,人類死亡後意識將在另外一個宇宙中繼續存活

據英國《每日快報》報道,一位科學家兼理論家Robert Lanza博士宣稱,世界上並不存在人類死亡,死亡的只是身體。他認爲我們的意識借助我們體內的能量生存,而且...

《屏裏狐》片頭曲《我愛狐狸精》歌詞是什麽?

《我愛狐狸精》 - 劉馨棋   (電視劇《屏裏狐》主題曲)   作詞:金十三&李旦   作曲:劉嘉   狐狸精 狐狸仙   千年修...

 
 
 
本示例爲設置工作表密碼 ActiveSheet.Protect Password:=641112 ' 保護工作表並設置密碼 ActiveSheet.Unprotect Password:=641112 '撤消工作表保護並取消密碼 '本示例保存當前活動工作簿的副本。 ActiveWorkbook.SaveCopyAs "C:\TEMP\XXXX.XLS" '本示例通過將 Saved 屬性設爲 True 來關閉包含本段代碼的工作簿,並放棄對該 工作簿的任何更改。 ThisWorkbook.Saved = True ThisWorkbook.Close '本示例對自動重新計算功能進行設置,使 Microsoft Excel 不對第一張工作表自 動進行重新計算。 Worksheets(1).EnableCalculation = False '下述過程打開 C 盤上名爲 MyFolder 的文件夾中的 MyBook.xls 工作簿。 Workbooks.Open ("C:\MyFolder\MyBook.xls") '本示例顯示活動工作簿中工作表 sheet1 上單元格 A1 中的值。 MsgBox Worksheets("Sheet1").Range("A1").Value 本示例顯示活動工作簿中每個工作表的名稱 For Each ws In Worksheets MsgBox ws.Name Next ws 本示例向活動工作簿添加新工作表 , 並設置該工作表的名稱? Set NewSheet = Worksheets.Add NewSheet.Name = "current Budget" 本示例將新建的工作表移到工作簿的末尾 'Private Sub Workbook_NewSheet(ByVal Sh As Object) Sh.Move After:=Sheets(Sheets.Count) End Sub 本示例將新建工作表移到工作簿的末尾 'Private Sub App_WorkbookNewSheet(ByVal Wb As Workbook, _ ByVal Sh As Object) Sh.Move After:=Wb.Sheets(Wb.Sheets.Count) End Sub 本示例新建一張工作表,然後在第一列中列出活動工作簿中的所有工作表的名稱。 Set NewSheet = Sheets.Add(Type:=xlWorksheet) For i = 1 To Sheets.Count NewSheet.Cells(i, 1).Value = Sheets(i).Name Next i 本示例將第十行移到窗口的最上面? Worksheets("Sheet1").Activate ActiveWindow.ScrollRow = 10 當計算工作簿中的任何工作表時,本示例對第一張工作表的 A1:A100 區域進行排序 。 'Private Sub Workbook_SheetCalculate(ByVal Sh As Object) With Worksheets(1) .Range("a1:a100").Sort Key1:=.Range("a1") End With End Sub 本示例顯示工作表 Sheet1 的打印預覽。 Worksheets("Sheet1").PrintPreview 本示例保存當前活動工作簿? ActiveWorkbook.Save 本示例保存所有打開的工作簿,然後關閉 Microsoft Excel。 For Each w In Application.Workbooks w.Save Next w Application.Quit 下例在活動工作簿的第一張工作表前面添加兩張新的工作表? Worksheets.Add Count:=2, Before:=Sheets(1) 本示例設置 15 秒後運行 my_Procedure 過程,從現在開始計時。 Application.OnTime Now + TimeValue("00:00:15"), "my_Procedure" 本示例設置 my_Procedure 在下午 5 點開始運行。 Application.OnTime TimeValue("17:00:00"), "my_Procedure" 本示例撤消前一個示例對 OnTime 的設置。 Application.OnTime EarliestTime:=TimeValue("17:00:00"), _ Procedure:="my_Procedure", Schedule:=False 每當工作表重新計算時,本示例就調整 A 列到 F 列的寬度。 'Private Sub Worksheet_Calculate() Columns("A:F").AutoFit End Sub 本示例使活動工作簿中的計算僅使用顯示的數字精度。 ActiveWorkbook.PrecisionAsDisplayed = True 本示例將工作表 Sheet1 上的 A1:G37 區域剪下,並放入剪貼板。 Worksheets("Sheet1").Range("A1:G37").Cut Calculate 方法 計算所有打開的工作簿、工作簿中的一張特定的工作表或者工作表中指定區域的單元 格,如下表所示: '要計算 '依照本示例 所有打開的工作簿 ' Application.Calculate (或只是 Calculate ) 指定工作表 '計算指定工作表Sheet1 Worksheets ("Sheet1").Calculate 指定區域 'Worksheets(1).Rows(2).Calculate 本示例對自動重新計算功能進行設置,使 Microsoft Excel 不對第一張工作表自動 進行重新計算。 Worksheets(1).EnableCalculation = False 本示例計算 Sheet1 已用區域中 A 列、B 列和 C 列的公式。 Worksheets("Sheet1").UsedRange.Columns("A:C").Calculate 本示例更新當前活動工作簿中的所有鏈接? ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources 本示例設置第一張工作表的滾動區域? Worksheets(1).ScrollArea = "a1:f10" 本示例新建一個工作簿,提示用戶輸入文件名,然後保存該工作簿。 Set NewBook = Workbooks.Add Do fName = Application.GetSaveAsFilename Loop Until fName False NewBook.SaveAs Filename:=fName 本示例打開 Analysis.xls 工作簿,然後運行 Auto_Open 宏。 Workbooks.Open "ANALYSIS.XLS" ActiveWorkbook.RunAutoMacros xlAutoOpen 本示例對活動工作簿運行 Auto_Close 宏,然後關閉該工作簿。 With ActiveWorkbook .RunAutoMacros xlAutoClose .Close End With 在本示例中,Microsoft Excel 向用戶顯示活動工作簿的路徑和文件名稱。 'Sub UseCanonical() Display the full path to user. MsgBox ActiveWorkbook.FullNameURLEncoded End Sub 本示例顯示當前工作簿的路徑及文件名(假定尚未保存此工作簿)。 MsgBox ActiveWorkbook.FullName 本示例關閉 Book1.xls,並放棄所有對此工作簿的更改。 Workbooks("BOOK1.XLS").Close SaveChanges:=False 本示例關閉所有打開的工作簿。如果某個打開的工作簿有改變,Microsoft Excel 將顯示詢問是否保存更改的對話框和相應提示。 Workbooks.Close 本示例在打印之前對當前活動工作簿的所有工作表重新計算? 'Private Sub Workbook_BeforePrint(Cancel As Boolean) For Each wk In Worksheets wk.Calculate Next End Sub 本示例對查詢表一中的第一列數據進行彙總,並在數據區域下方顯示第一列數據的總 和。 Set c1 = Sheets("sheet1").QueryTables(1).ResultRange.Columns(1) c1.Name = "Column1" c1.End(xlDown).Offset(2, 0).Formula = "=sum(Column1)" 本示例取消活動工作簿中的所有更改? ActiveWorkbook.RejectAllChanges 本示例在商業問題中使用規劃求解函數,以使總利潤達到最大值。SolverSave 函數 將當前問題保存到活動工作表上的某一區域。 Worksheets("Sheet1").Activate SolverReset SolverOptions Precision:=0.001 SolverOK SetCell:=Range("TotalProfit"), _ MaxMinVal:=1, _ ByChange:=Range("C4:E6") SolverAdd CellRef:=Range("F4:F6"), _ Relation:=1, _ FormulaText:=100 SolverAdd CellRef:=Range("C4:E6"), _ Relation:=3, _ FormulaText:=0 SolverAdd CellRef:=Range("C4:E6"), _ Relation:=4 SolverSolve UserFinish:=False SolverSave SaveArea:=Range("A33") 本示例隱藏 Chart1、Chart3 和 Chart5。 Charts(Array("Chart1", "Chart3", "Chart5")).Visible = False 當激活工作表時,本示例對 A1:A10 區域進行排序。 'Private Sub Worksheet_Activate() Range("a1:a10").Sort Key1:=Range("a1"), Order:=xlAscending End Sub 本示例更改 Microsoft Excel 鏈接。 ActiveWorkbook.ChangeLink "c:\excel\book1.xls", _ "c:\excel\book2.xls", xlExcelLinks 本示例啓用受保護的工作表上的自動篩選箭頭? ActiveSheet.EnableAutoFilter = True ActiveSheet.Protect contents:=True, userInterfaceOnly:=True 本示例將活動工作簿設爲只讀? ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly 本示例使共享工作簿每三分鍾自動更新一次? ActiveWorkbook.AutoUpdateFrequency = 3 下述 Sub 過程清除活動工作簿中 Sheet1 上的所有單元格的內容。 'Sub ClearSheet() Worksheets("Sheet1").Cells.ClearContents End Sub 本示例對所有工作簿都關閉滾動條? Application.DisplayScrollBars = False 如果具有密碼保護的工作簿的文件屬性沒有加密,則本示例設置指定工作簿的密碼加 密選項。 'Sub SetPasswordOptions() With ActiveWorkbook If .PasswordEncryptionProvider "Microsoft RSA SChannel Cryptographic Provider" Then .SetPasswordEncryptionOptions _ PasswordEncryptionProvider:="Microsoft RSA SChannel Cryptographic Provider", _ PasswordEncryptionAlgorithm:="RC4", _ PasswordEncryptionKeyLength:=56, _ PasswordEncryptionFileProperties:=True End If End With End Sub 在本示例中,如果活動工作簿不能進行寫保護,那麽 Microsoft Excel 設置字符串 密碼以作爲活動工作簿的寫密碼。 'Sub UseWritePassword() Dim strPassword As String strPassword = "secret" ' Set password to a string if allowed. If ActiveWorkbook.WriteReserved = False Then ActiveWorkbook.WritePassword = strPassword End If End Sub 在本示例中,Microsoft Excel 打開名爲 Password.xls 的工作簿,設置它的密碼 ,然後關閉該工作簿。本示例假定名爲 Password.xls 的文件位于 C:\ 驅動器上。 'Sub UsePassword() Dim wkbOne As Workbook Set wkbOne = Application.Workbooks.Open("C:\Password.xls") wkbOne.Password = "secret" wkbOne.Close '注意 Password 屬性可讀並返回 「********」。 End Sub 本示例將 Book1.xls 的當前窗口更改爲顯示公式。 Workbooks("BOOK1.XLS").Worksheets("Sheet1").Activate ActiveWindow.DisplayFormulas = True '本示例接受活動工作簿中的所有更改? ActiveWorkbook.AcceptAllChanges 本示例顯示活動工作簿的路徑和名稱 Sub UseCanonical() MsgBox '消息框 [b7] = ActiveWorkbook.FullName '當前工作簿 [b8] = ActiveWorkbook.FullNameURLEncoded '活動工作簿 End Sub 本示例顯示 Microsoft Excel 啓動文件夾的完整路徑。 MsgBox Application.StartupPath Activate 事件 激活一個工作簿、工作表、圖表或嵌入圖表時産生此事件。 當激活工作表時,本示例對 A1:A10 區域進行排序。 Private Sub Worksheet_Activate() Range("a1:a10").Sort Key1:=Range("a1"), Order:=xlAscending End Sub Calculate 事件 對于 Worksheet 對象,在對工作表進行重新計算之後産生此事件 每當工作表重新計算時,本示例就調整 A 列到 F 列的寬度。 Private Sub Worksheet_Calculate() Columns("A:F").AutoFit End Sub 本示例向活動工作簿添加新工作表,並設置該工作表的名稱。 Set newSheet = Worksheets.Add newSheet.Name = "current Budget" 本示例關閉工作簿 Book1.xls,但不提示用戶保存所作更改。Book1.xls 中的所有 更改都不會保存。 Application.DisplayAlerts = False Workbooks("BOOK1.XLS").Close Application.DisplayAlerts = True 示例顯示每一個可用加載宏的路徑及文件名。 For Each a In AddIns MsgBox a.FullName Next a ChDir 語句 改變當前的目錄或文件夾。 ChDir path 在 Power Macintosh 中,默認驅動器總是改爲在 path 語句中指定的驅動器。完整 路徑指定由卷標名開始,相對路徑由冒號 (:) 開始. ChDir 可以辨認路徑中指定的 別名: ChDir "MacDrive:Tmp" ' 在 Macintosh 中 本示例顯示當前路徑分隔符。 MsgBox "The path separator character is " & _ Application.PathSeparator Move 方法 將一個指定的文件或文件夾從一個地方移動到另一個地方。 語法 object.Move destination Move 方法語法有如下幾部分: 部分 描述 object 必需的。始終是一個 File 或 Folder 對象的名字。 destination 必需的。文件或文件夾要移動到的目標。不允許有通配符。 CreateFolder 方法 創建一個文件夾。 語法 object.CreateFolder(foldername) reateFolder 方法有如下幾部分: 部分 描述 object 必需的。始終是一個 FileSystemObject 的名字。 foldername 必需的。字符串表達式,它標識創建的文件夾。 本示例使用 MkDir 語句來創建目錄或文件夾。如果沒有指定驅動器,新目錄或文件 夾將會建在當前驅動器中。 MkDir "MYDIR" ' 建立新的目錄或文件夾。 Name 語句示例 本示例使用 Name 語句來更改文件的名稱。示例中假設所有使用到的目錄或文件夾都 已存在。 在 Macintosh 中,默認驅動器名稱是 「HD」 並且路徑部分由冒號取代 反斜線隔開。 Dim OldName, NewName OldName = "OLDFILE": NewName = "NEWFILE" ' 定義文件名。 Name OldName As NewName ' 更改文件名。 OldName = "C:\MYDIR\OLDFILE": NewName = "C:\YOURDIR\NEWFILE" Name OldName As NewName ' 更改文件名,並移動文件。 本示例設置替換啓動文件夾。 Application.AltStartupPath = "C:\EXCEL\MACROS" FolderExists 方法 如果指定的文件夾存在返回 True,不存在返回 False。 語法 object.FolderExists(folderspec) 本示例在單元格中啓用編輯。 Application.EditDirectlyInCell = True 程序說明: 幾種用VBA在單元格輸入數據的方法: Public Sub Writes() 1-- 2 方法,最簡單在 "[ ]" 中輸入單元格名稱。 1 [A1] = 100 '在 A1 單元格輸入100。 2 [A2:A4] = 10 '在 A2:A4 單元格輸入10。 3-- 4 方法,采用 Range(" "), " " 中輸入單元格名稱。 3 Range("B1") = 200 '在 B1 單元格輸入200。 4 Range("C1:C3") = 300 '在 C1:C3 單元格輸入300。 5-- 6 方法,采用 Cells(Row,Column),Row是單元格行數,Column是單元格欄數。 5 Cells(1, 4) = 400 '在 D1 單元格輸入400。 6 Range(Cells(1, 5), Cells(5, 5)) = 50 '在 E1:E 5單元格輸入50。 End Sub VBALesson3 程序說明: 如何利用 Worksheet_SelectionChange 輸入數據的方法。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Target = 100 End Sub VBALesson4 程序說明: 如何利用 Worksheet_SelectionChange 在限定的單元格輸入數據的方法。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Row >= 2 And Target.Column = 2 Then Target = 100 End If End Sub VBALesson5 程序說明: 比較 Worksheet_SelectionChange() 與用按鈕 CommandButton1_Click() 來執行 程序二者的方法與寫法有何不同。 Worksheet_SelectionChange()事件 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Row >= 2 And Target.Column = 2 Then Target = 100 End If End Sub 按鈕 CommandButton1_Click() Private Sub CommandButton1_Click() If ActiveCell.Row >= 2 And ActiveCell.Column >= 3 Then ActiveCell = 100 End If End Sub 二者執行方法最大的地方,在于 Worksheet_SelectionChange() 是自動的,你不用 了解他是怎麽完成工作的。 按鈕 CommandButton1_Click() 是人工的,比 SelectionChange()多一道手續, 就是要去按那接鈕,程序才會執行。 SelectionChange() 有一個參數 Target 可用;CommandButton1_Click ()沒有。 所以我們要用 ActiveCell 內定函數來取代Target,ActiveCell 與 Target最大的 不同點他只能指定一個單元格。 就是你選取多個單元格也只有最上面的單元格會加上數據;用 Selection 取代 ActiveCell, 用法就跟 Target 一樣了。 VBALesson 6 程序說明: 完整的 If...Then ┅ End 邏輯判斷式。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Row >= 2 And Target.Column = 2 Then Target = 200 ElseIf Target.Row >= 2 And Target.Column = 3 Then Target = 300 ElseIf Target.Row >= 2 And Target.Column = 2 Then Target = 400 Else Target = 500 End If End Sub 這是個完整的 If 邏輯判斷式,意思是說,假如 If 後的判斷式條件成立的話,就 執行第二條程序,否則假如 ElseIf 後的判斷式條件成立的話,就執行第四條程序 ,否則假如另一個 ElseIf 後的判斷式條件成立的話,就執行第六條程序。 Else 的意思是說,假如以上條件都不成立的話,就執行第八條程序。 他的執行方式是假如 IF 的條件成立的話,就不執行其它ElseIf 及Else 的邏輯判 斷式,假如 If 後的條件不成立的話才會執行 ElseIf 或 Else 邏輯判斷式。第二 個 ElseIf後的條件因爲與 IF 後的條件一樣,所以這個判斷式後面的 Target=400 將是永遠無法執行到的程序。 VBALesson 7 程序說明∶我們爲什麽要用變數。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim i , j As Integer Dim k As Range i = Target.Row j = Target.Column Set k = Target If i >= 2 And j = 2 Then k = 200 ElseIf i >= 2 And j = 3 Then k = 300 ElseIf i >= 2 And j = 4 Then k = 400 Else k = 500 End If End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim iRow, iCol As Integer iRow = Target.Row iCol = Target.Column If iRow >= 2 And iCol = 2 And Target "" Then Application.EnableEvents = False Cells(iRow, iCol + 1) = Cells(iRow, iCol) * 2 Application.EnableEvents = True ElseIf iRow >= 2 And iCol = 2 And Target = "" Then Cells(iRow, iCol + 1) = "" Else Cells(iRow, iCol + 1) = "" End If End Sub 前幾個教程都是用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()事件。 VBALesson 9 程序說明∶體會一下Worksheet_Change()事件連鎖反應。 Private Sub Worksheet_Change(ByVal Target As Range) Dim iRow As Integer iRow = Target.Row Application.EnableEvents = False Cells(iRow, 3) = Cells(iRow, 3) + Cells(iRow, 2) Application.EnableEvents = True End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim iRow As Integer iRow = Target.Row 'Application.EnableEvents = False Cells(iRow, 3) = Cells(iRow, 3) + Cells(iRow, 2) 'Application.EnableEvents = True End Sub 這個程序的目的是要在 B2 輸入新的數?時,C2 會將 B2 輸入的新數?加上 C2 原 有的數?呈現在 C2 上。 照上面有加上 Application.EnableEvents = False 程序執行當然沒問題。 現在你在 Application.EnableEvents = False 與 Application.EnableEvents = True 前加上「 '」看看。 程序前加上「 '」的目的是要使「 '」之後的文字變成說明文字,程序執行時是會跳 過說明文字,不執行說明文字的內容。 程序前加上「 '」符號後,文字會變成綠色。 執行第二個程序時,你將發現 C2 不會按你所要求的,呈現結果。 這就是所謂的事件連鎖反應。 請問這個宏該如何寫! 我想運行一個宏,就能在當前工作表B3上填上一條公式;這條公式的結果是所有工作 表上的B4單元格的和.請問這個宏該如何寫.謝謝! Sub gg() Dim sh As Worksheet, shname$ For Each sh In Worksheets shname = sh.Name ActiveSheet.Range("b3").value = ActiveSheet.Range("b3").value + Worksheets(shname).Range("b4") Next End Sub VBA中怎樣創建一個名爲「table」的新工作表 通過VBA編程,很容易添加新的工作表,但是新表的名字不知怎樣控制,對于新創建 的工作表,由于其名字並非特定,所以就不好使用所創建的新表了。不知各位有何高 見。。。。 Sheets.Add ActiveSheet.Name = "table" 請教:如何用VBA檢索表1中A列與表2,3,4,5.....中A列相同的行並把後者整行拷 貝到表1檢索到的行中,謝謝!!!! To yxptwq∶用這程序試看看。 Sub Copy1() Dim Row_dn1, Row_dnN, i, j, n As Integer Row_dn1 = Sheet1.Range("A65536").End(xlUp).Row k = 1: n = 1 For Each wSheet In ActiveWorkbook.Worksheets With wSheet If .Name "Sheet1" Then Row_dnN = .Range("A65536").End(xlUp).Row For i = 2 To Row_dn1 For j = 2 To Row_dnN If .Cells(j, 1) = Sheet1.Cells(i, 1) Then .Rows(j & ":" & j).Copy Destination:=Sheet1.Rows(Row_dn1 + n & ":" & Row_dn1 + n) n = n + 1 End If Next j Next i End If End With Next wSheet End Sub 如果要用VBA程式輸入密碼使用下列程式碼 Sub EnterNewPW() '程式說明:利用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 鍵(跳到第一次輸入密碼 Textbox myPW = "chijanzen" '假設密碼 chijanzen Application.SendKeys myPW, True '輸入密碼 Application.SendKeys "{TAB}", True 'TAB 鍵(跳到第二次輸入密碼 Textbox Application.SendKeys myPW, True '輸入密碼 Application.SendKeys "{ENTER}", True '按確定鈕(預設值) Application.SendKeys "%{F11}", True '返回Excel視窗 End Sub 冒泡排序法: 冒泡排序法之所以成爲「冒泡排序」是因爲值較小的或是較輕的元素浮到作爲繼續排 序的一組數的頂部。 Sub Macro1() Dim i As Integer Dim j As Integer Dim t as integer Static number(1 To 10) As Integer For i = 1 To 10 number(i) = inputbox「輸入要排序的數:」 Next i For i = 10To 2 Step -1 For j = 1 To i – 1 『下面進行位置交換 If number(j) > number(j + 1) Then t = number(j + 1) number(j + 1) = number(j) number(j) = t End If Next j Next i For i = 1 To 20 Print number(i) Next i End sub 首先定義一個數組:通過循環錄入10個整數,然後用一個二重循環測試前一個數是否 大于後一個數。如果大于則交換兩個數的下標,即交換兩個數在數組中的位置,交換 通過一個變量來進行。 我先用傳統的方法解決這個問題,經過比較,選用了較爲簡單的和高效的排序方法 ——「快速排序」,具體算法可參考數據結構等有關書籍。對所有數據排序後再合 並相同數據,合並程序較爲簡便,我開始時采用了這種方法,但後來發現對于這些 的數據,先合並後排序速度更快,因爲有大量相同的數據。合並是采用「標記」算 法,具體如下:(設數據已存放在sData()數組中 ,結果存到Queryp()數組, Amount是數據個數) '把相同元素置 0 For i = 1 To Amount If sData(i) 0 Then For j = i + 1 To Amount If sData(i) = sData(j) Then sData(j) = 0 Next j End If Next i '刪除相同元素 Queryp(1) = sData(1) k = 1 For i = 2 To Amount If Not (sData(i) = 0) Then k = k + 1 Queryp(k) = sData(i) End If Next i kMax = k ReDim Preserve Queryp(kMax) 雖然這樣使得運算速度有所高,但是仍然要進行大量的循環運算,占據了程序大部 分的運算時間。于是我一直在尋覓一種更爲高效的算法。 功夫不負有心人,在仔細分析數據的特征,比較了多種方案之後,我終于找到了一 種相當成功的算法,原來要3到4秒的運算縮短到僅需0.1到0.2秒。 我遇到的數據具有以下特征:①相同數據很多,②最大、最小數之間相差不到3, ③都是帶兩位小數的正數。 針對數據的特征,我采用了以下算法: 針對數據的特征,我采用了以下算法: 步驟: 1. 用一個循環找出整數和小數部分的最大、最小值。小數部分的最大、最小值乘 以100轉爲整數。 2. 定義一個二維數組,下標範圍分別是整數和小數部分的最小值到最大值。 3. 再用一個循環把所有源數據填入剛才定義的二維數組,填寫規則是,源數據的 整數和小數部分分別對應二維數組的兩個下標。例如,「13.51"填到「A(13,51)" 中。 4. 最後順向或逆向讀取二維數組中的非零數據即可得到從小到大或從大到小排列 的數據,而且不會含有重複數據。 用VB 編寫的程序如下: '****密集型數據處理**** Dim i As Long, j As Long, k As Long, kMax As Long Dim Queryp() As Single ReDim Queryp(Amount) Dim IntegerPart As Integer, DecimalPart As Integer Dim IPmax As Integer, IPmin As Integer Dim DPmax As Integer, DPmin As Integer Dim DiffDataArray() '讀取數據 ReadData IPmax = 0: IPmin = 1000 DPmax = 0: DPmin = 99 For i = 1 To Amount ' 找整數和小數部分的最大、最小值 IntegerPart = Int(sData(i)) DecimalPart = (sData(i) - IntegerPart) * 100 If IntegerPart > IPmax Then IPmax = IntegerPart ElseIf IntegerPart DPmax Then DPmax = DecimalPart ElseIf DecimalPart 0 Then k = k + 1 Queryp(k) = DiffDataArray(i, j) End If Next j Next i kMax = k ReDim Preserve Queryp(kMax) 該方法對于本人遇到的這種「密集型」數據最爲有效,但是如果遇上「稀疏型」數 據,例如最大、最小值相差幾千,甚至上萬的數據,就沒什麽優勢了,而且會占用 較大的內存。 經過改進,我得到了處理稀疏型數據的高效算法。高效的前提條件同樣是源數據具 有大量相同數據。思路是在前一種方法的基礎上增加一個單維數組,用來保存整數 部分數據,保存過程中用插入法對其進行排序。因爲有大量重複數據,要排序的數 據量相對較少。當從二維數組中讀取數據時,用單維數組代入二維數組的第一個下 標,具體代碼下: '****稀疏型數據處理**** Dim i As Long, j As Long, k As Long, kMax As Long Dim Queryp() As Single ReDim Queryp(Amount) Dim IntegerPart As Integer, DecimalPart As Integer Dim IPmax As Integer, IPmin As Integer Dim DPmax As Integer, DPmin As Integer Dim IPArray() As Integer, IPAamount As Integer ReDim IPArray(Amount) Dim DiffDataArray() '讀取數據 ReadData IPmax = 0: IPmin = 1000 DPmax = 0: DPmin = 99 IPAamount = 0 For i = 1 To Amount '獲取整數和小數部分的最大最小值 IntegerPart = Int(sData(i)) DecimalPart = (sData(i) - IntegerPart) * 100 If IntegerPart > IPmax Then IPmax = IntegerPart ElseIf IntegerPart DPmax Then DPmax = DecimalPart ElseIf DecimalPart IPArray(j) Then IPAamount = IPAamount + 1 For k = IPAamount To j + 1 Step -1 IPArray(k) = IPArray(k - 1) Next k IPArray(j) = IntegerPart Exit For ElseIf IntegerPart = IPArray(j) Then Exit For End If Next j If j > IPAamount Then IPAamount = IPAamount + 1 IPArray(IPAamount) = IntegerPart End If Next i ReDim DiffDataArray(IPmin To IPmax, DPmin To DPmax) '填入數據 For i = 1 To Amount IntegerPart = Int(sData(i)) DecimalPart = (sData(i) - IntegerPart) * 100 DiffDataArray(IntegerPart, DecimalPart) = sData(i) Next i '提取數據 k = 0 For i = 1 To IPAamount For j = DPmax To DPmin Step -1 If DiffDataArray(IPArray(i), j) 0 Then k = k + 1 Queryp(k) = DiffDataArray(IPArray (i), j) End If Next j Next i kMax = k ReDim Preserve Queryp(kMax) k ReDim Preserve Queryp(kMax) 自動隱藏表格中無數據的行 表1 是數據源,經常改變; 表2 引用表1 中某列有數據的單元格(利用動態位址已實現。) 由于表1 的改變,表2 的大小隨之而變。 問題:如何實現表2 中沒有數據的行(有公式)自動隱藏?謝謝賜教! Sub abc() For i = 1 To 300 If Cells(i, 1).value = "" Then Rows(i).Hidden = True Next i End Sub 你寫的語句可以解決隱藏的問題,可是如果我執行了它之後,再在表1中增加數據, 表2不會自動顯示有了數據的行。如何修改? 將此宏設爲自動運行(打開文件時) Sub abc() For i = 1 To 300 If Cells(i, 1).value "" Then Rows(i).Hidden = false Next i End Sub 用VBA如何自動合並列的內容? 用VBA如何自動合並列的內容? To hongjian : Sub MergeTest() For i = 3 To 30 Cells(i, 3) = Cells(i, 1) & Chr(10) & Cells(i, 2) Next End Sub 1)創建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並創建了一個新的包含一個工作表的工作薄: Dim zsbexcel As Excel.Application Set zsbexcel = New Excel.Application zsbexcel.Visible = True 如要Excel不可見,可使zsbexcel.Visible = False zsbexcel.SheetsInNewWorkbook = 1 Set zsbworkbook = zsbexcel.Workbooks.Add 2)設置單元格和區域值 要設置一張工作表中每個單元格的值,可以使用Worksheet對象的 Range屬性或Cells屬性。 With zsbexcel.ActiveSheet .Cells(1, 2).value = "100" .Cells(2, 2).value = "200" .Cells(3, 2).value = "=SUM(B1:B2)" .Range("A3:A9") = "中國人民解放軍" End With 要設置單元格或區域的字體、邊框,可以利用Range對象或Cells對象 的Borders屬性和Font屬性: With objexcel.ActiveSheet.Range("A2:K9").Borders  '邊框設置 .Line = xlBorderLine .Weight = xlThin .ColorIndex = 1 End With With objexcel.ActiveSheet.Range("A3:K9").Font  '字體設置 .Size = 14 .Bold = True .Italic = True .ColorIndex = 3 End With 通過對Excel單元格和區域值的各種設置的深入了解,可以創建各種複 雜、美觀、滿足需要的、具有自己特點的報表。 3)預覽及打印 生成所需要的工作表後,就可以對EXCEL發出預覽、打印指令了。 zsbexcel.ActiveSheet.PageSetup.Orientation = xlPortrait   ' 設置打印方向 zsbexcel.ActiveSheet.PageSetup.PaperSize = xlPaperA4   ' 設置打印紙的打下 zsbexcel.Caption = "打印預覽"        '設置預覽窗口的 標題 zsbexcel.ActiveSheet.PrintPreview      '打印預覽 zsbexcel.ActiveSheet.PrintOut        '打印輸出 通過打印方向、打印紙張大小的設置,不斷進行預覽,直到滿意爲止, 最終進行打印輸出。 爲了在退出應用程序後EXCEL不提示用戶是否保存已修改的文件,需使 用如下語句: zsbexcel.DisplayAlerts = False zsbexcel.Quit    '退出EXCEL zsbexcel.DisplayAlerts = True 如此設計的報表打印是通過 EXCEL程序來後台實現的。對于使用者來 說,根本看不到具體過程,只看到一張張漂亮的報表輕易地被打印出來了。 4)具體實例 下面給出一個具體實例,它在window98、Visual Basic 6.0、 Microsoft Office97的環境下調試通過。 在VB中啓動一個新的Standard EXE工程,在「工程」菜單的「引用」 選項下引用Excel Object Library;然後在Form中添加一個命令按鈕 cmdExcel;最後在窗體中輸入如下代碼: Dim zsbexcel As Excel.Application Private Sub cmdExcel_Click() Set zsbexcel = New Excel.Application zsbexcel.Visible = True zsbexcel.SheetsInNewWorkbook = 1 Set zsbworkbook = zsbexcel.Workbooks.Add With zsbexcel.ActiveSheet.Range("A2:C9").Borders   '邊框設置 .Line = xlBorderLine .Weight = xlThin .ColorIndex = 1 End With With zsbexcel.ActiveSheet.Range("A3:C9").Font  '字體設置 .Size = 14 .Bold = True .Italic = True .ColorIndex = 3 End With zsbexcel.ActiveSheet.Rows.HorizontalAlignment = xlVAlignCenter   '水平居中 zsbexcel.ActiveSheet.Rows.VerticalAlignment = xlVAlignCenter    '垂直居中 With zsbexcel.ActiveSheet .Cells(1, 2).value = "100" .Cells(2, 2).value = "200" .Cells(3, 2).value = "=SUM(B1:B2)" .Cells(1, 3).value = "中國人民解放軍" .Range("A3:A9") = "50" End With zsbexcel.ActiveSheet.PageSetup.Orientation = xlPortrait    ' xlLandscape zsbexcel.ActiveSheet.PageSetup.PaperSize = xlPaperA4 zsbexcel.ActiveSheet.PrintOut zsbexcel.DisplayAlerts = False zsbexcel.Quit zsbexcel.DisplayAlerts = True Set zsbexcel = Nothing 提高EXCEL中VBA的效率 方法1:盡量使用VBA原有的屬性、方法和Worksheet函數 由于Excel對象多達百多個,對象的屬性、方法、事件多不勝數,對于初學者來 說可能對它們不全部了解,這就産生了編程者經常編寫與Excel對象的屬性、方法相 同功能的VBA代碼段,而這些代碼段的運行效率顯然與Excel對象的屬性、方法完成 任務的速度相差甚大。例如用Range的屬性CurrentRegion來返回 Range 對象,該對 象代表當前區。(當前區指以任意空白行及空白列的組合爲邊界的區域)。同樣功能 的VBA代碼需數十行。因此編程前應盡可能多地了解Excel對象的屬性、方法。 充分利用Worksheet函數是提高程序運行速度的極度有效的方法。如求平均工資 的例子:For Each c In Worksheet(1).Range(″A1:A1000″) Totalvalue = Totalvalue + c.value Next Averagevalue = Totalvalue / Worksheet(1).Range(″ A1:A1000″).Rows.Count 而下面代碼程序比上面例子快得多: Averagevalue="/blog/Application.WorksheetFunction.Average(Worksheets (1).Range(″A1:A1000″)) 其它函數如Count,Counta,Countif,Match,Lookup等等,都能代替相同功能的 VBA程序代碼,提高程序的運行速度。 方法2:盡量減少使用對象引用,尤其在循環中 每一個Excel對象的屬性、方法的調用都需要通過OLE接口的一個或多個調用, 這些OLE調用都是需要時間的,減少使用對象引用能加快VBA代碼的運行。例如 1.使用With語句。 Workbooks(1).Sheets(1).Range(″A1:A1000″).Font.Name=″Pay″ Workbooks(1).Sheets(1).Range(″A1:A1000″).Font.Font ... 則以下語句比上面的快 With Workbooks(1).Sheets(1).Range(″A1:A1000″).Font .Name = ″Pay″ .Font = ″Bold″ ... End With 2.使用對象變量。 如果你發現一個對象引用被多次使用,則你可以將此對象用Set 設置爲對象變 量,以減少對對象的訪問。如: Workbooks(1).Sheets(1).Range(″A1″).value = 100 Workbooks(1).Sheets(1).Range(″A2″).value = 200 則以下代碼比上面的要快: Set MySheet = Workbooks(1).Sheets(1) MySheet.Range(″A1″).value = 100 MySheet.Range(″A2″).value = 200 3.在循環中要盡量減少對象的訪問。 For k = 1 To 1000 Sheets(″Sheet1″).Select Cells(k,1).value = Cells(1,1).value Next k 則以下代碼比上面的要快: Set Thevalue = Cells(1,1).value Sheets(″Sheet1″).Select For k = 1 To 1000 Cells(k,1).value = Thevalue Next k 方法3:減少對象的激活和選擇 如果你的通過錄制宏來學習VBA的,則你的VBA程序裏一定充滿了對象的激活和選 擇,例如Workbooks(XXX).Activate、Sheets(XXX).Select、Range(XXX).Select等 ,但事實上大多數情況下這些操作不是必需的。例如 Sheets(″Sheet3″).Select Range(″A1″).value = 100 Range(″A2″).value = 200 可改爲: With Sheets(″Sheet3″) .Range(″A1″).value = 100 .Range(″A2″).value = 200 End With 方法4:關閉屏幕更新 如果你的VBA程序前面三條做得比較差,則關閉屏幕更新是提高VBA程序運行速度 的最有效的方法,縮短運行時間2/3左右。關閉屏幕更新的方法: Application.ScreenUpdate = False 請不要忘記VBA程序運行結束時再將該值設回來: Application.ScreenUpdate = True 以上是提高VBA運行效率的比較有效的幾種方法
󰈣󰈤
 
 
 
  免責聲明:本文僅代表作者個人觀點,與王朝網路無關。王朝網路登載此文出於傳遞更多信息之目的,並不意味著贊同其觀點或證實其描述,其原創性以及文中陳述文字和內容未經本站證實,對本文以及其中全部或者部分內容、文字的真實性、完整性、及時性本站不作任何保證或承諾,請讀者僅作參考,並請自行核實相關內容。
 
 
寶貝清純百變豬豬
美女喜太狼裙裝時代
美麗幹練的OL
平面模特楊棋涵
石系列印象
海洲錦屏磷礦
再憶桂林
觀:重金屬所攝影:元陽梯田所想
 
>>返回首頁<<
 
 
 
 熱帖排行
 
 
 
 
© 2005- 王朝網路 版權所有