【正文】 LBARNAME As String = 我的工具欄Sub CreateToolbar()Dim TBar As CommandBarDim Btn As CommandBarButton39。如果存在則刪除已存在的工具欄On Error Resume NextCommandBars(TOOLBARNAME).DeleteOn Error GoTo 039。創(chuàng)建工具欄Set TBar = With TBar.Name = TOOLBARNAME.Visible = TrueEnd With39。添加按鈕Set Btn = (Type:=msoControlButton)With Btn.FaceId = 300.OnAction = Macro1.Caption = 這里是Macro1的提示End With39。添加另一個按鈕Set Btn = (Type:=msoControlButton)With Btn.FaceId = 25.OnAction = Macro2.Caption = 這里是Macro2的提示End WithEnd Sub圖1顯示了帶有這兩個按鈕的工具欄。圖1：一個老式工具欄，位于加載項(xiàng)選項(xiàng)卡的自定義工具欄中代碼中使用了一個模塊級的常量TOOLBARNAME，用來存儲工具欄的名稱，并用于這兩個過程中。如果已存在具有相同名字的工具欄，則該過程先刪除該工具欄。這樣將會避免企圖創(chuàng)建與已存在的工具欄有相同名稱的工具欄時，產(chǎn)生錯誤。通過使用CommandBars對象的Add方法來創(chuàng)建該工具欄，使用Controls對象的Add方法來添加兩個按鈕，每個按鈕都有三個屬性： FaceID:確定顯示在按鈕中的圖像的數(shù)字。 OnAction:在單擊按鈕時執(zhí)行的宏。 Caption:鼠標(biāo)指針懸浮在按鈕上時顯示的屏幕提示。 技巧：不僅可以設(shè)置FaceID屬性，還可以設(shè)置Picture屬性，使用任何的imageMso圖像。例如，下面的語句晶粒示一個綠色的勾號：.Picture = _(AcceptInvitation, 16, 16)關(guān)于imageMso圖像的更多信息，請參見“定制RibbonX”。在關(guān)閉工作簿時，觸發(fā)Workbook_BeforeClose事件過程，調(diào)用過程DeleteToolbar:Sub DeleteToolbar()On Error Resume NextCommandBars(TOOLBARNAME).DeleteOn Error GoTo 0End Sub如果是打開當(dāng)前已打開的工作表的目錄下的文件，可用 來指代此目錄。 amp。 \ amp。 文件名 if right(,1) \then amp。 \ amp。 文件名 else amp。 文件名 end if 如果文件名不知道，需VBA檢測的話，程序就多了。樓上說完了，我湊熱鬧。 其實(shí)如果在同一個目錄下，你直接 文件名　　 就可以 和　 你可以在book1中寫： 刪除空格的方法Range(C2:C94).SpecialCells(4). 解釋: 4表示xlCellTypeBlanks 空單元格。 SpecialCells 方法 參閱應(yīng)用于示例特性返回一個 Range 對象，該對象代表與指定類型及值相匹配的所有單元格。Range 對象。 (Type, Value) expression 必需。該表達(dá)式返回“應(yīng)用于”列表中的一個對象。 Type XlCellType 類型，必需。要包含的單元格。 XlCellType 可為以下 XlCellType 常量之一。 xlCellTypeAllFormatConditions 任意格式單元格 xlCellTypeAllValidation 含有驗(yàn)證條件的單元格 xlCellTypeBlanks 空單元格 xlCellTypeComments 含有注釋的單元格 xlCellTypeConstants 含有常量的單元格 xlCellTypeFormulas 含有公式的單元格 xlCellTypeLastCell 使用區(qū)域中最后的單元格 xlCellTypeSameFormatConditions 含有相同格式的單元格 xlCellTypeSameValidation 含有相同驗(yàn)證條件的單元格 xlCellTypeVisible 所有可見單元格 本示例選定工作表 Sheet1 中已用區(qū)域的最后一個單元格。 Worksheets(Sheet1).Activate (xlCellTypeLastCell) .Activate我的宏（刪除空格）Sub 刪除空格() xcolum = Columns(xcolum).Select (xlCellTypeBlanks).End Sub(a1). 39。選定數(shù)據(jù)區(qū)域(4). 39。刪除含有空格的行如何使VBA能彈出 確認(rèn)/取消 對話框 如果按一個執(zhí)行安鈕 后會彈出 確認(rèn)對話框，按確認(rèn) 則程序執(zhí)行下去 按取消則不執(zhí)行 Dim AnswerAnswer = MsgBox(您是否要更新？ amp。 _ vbCrLf amp。 vbCrLf amp。 如更新，請單擊“確定”。 amp。 _ vbCrLf amp。 vbCrLf amp。 如稍后更新，請單擊“取消”。, _ vbQuestion + vbOKCancel + vbDefaultButton2, 更新數(shù)據(jù)庫)If Answer = vbOK Then 39。此處加原代碼Else EndEnd IfEnd Sub不彈出對話框 = False = True=IF(ISERROR(VLOOKUP(A2,Sheet2!A:A,FALSE)),VLOOKUP(A2,Sheet2!A:A,FALSE))去掉cell的公式With Cells.Copy.PasteSpecial Paste:=xlPasteValues.Cells(1, 1).Select = FalseEnd WithVba中公式套用For i = 2 To LastRow 39。 select the next row based on loop vString = A amp。 i If IsError((Range(vString).Value, vRange, 31, False)) Then Y = NEW Else Y = (Range(vString).Value, vRange, 31, False) End If 39。 write the result to the active workbook Cells(i, 31).Value = YNext iSub AutoLookup() With ActiveWindow On Error Resume Next mcolumn = Index = 2 For j = mcolumn + 1 To mcolumn + 6 For i = 1 To Dim str As String If IsError(((i, 4), Sheets(基站表).Range(A:G), Index, 0)) = True Then (i, j) = N/A Else(i, j) = ((i, 4), Sheets(基站表).Range(A:G), Index, 0) End If Next i Index = Index + 1 Next j End WithEnd Sub刪除空行Dim i As LongWith Application .Calculation = xlCalculationManual .ScreenUpdating = FalseFor i = Range(A1040000).End(xlUp).Row To 1 Step 1If Cells(i, 1) = Then Sheets(11).Rows(i).Next i .Calculation = xlCalculationAutomatic .ScreenUpdating = TrueEnd With=False 39。讀取或?qū)懭霐?shù)據(jù)的代碼 Workbooks().Close SaveChanges:=True =TruePrivate Sub CommandButton1_Click()Sub CommandButton1_Click() Call Macro1End SubPrivate Sub CommandButton2_Click()Sub CommandButton2_Click()39。39。根據(jù)項(xiàng)目名稱 獲取部門名39。A8 顯示在B8中 c3c40Dim xDis As IntegerDim xNo As IntegerDim strProject 39。項(xiàng)目名稱Dim strDep 39。制造部門 Dim myPath$, myFile$, AK As Workbook, aRow%, tRow%, i As Integer = False 39。凍結(jié)屏幕，以防屏幕抖動 myPath = amp。 \ 39。把文件路徑定義給變量 myFile = Dir(myPath amp。 ) 39。依次找尋指定路徑中的*.xls文件xDis = 40 strname = Set AK = (myPath amp。 myFile) 39。打開符合要求的文件For xNo = 3 To xDis strProject = Workbooks(strname).Worksheets(System).Range(A8).Value strDep = Workbooks(strname).Worksheets(System).Range(B8).Value If (strProject = (二部).Range(C amp。 CStr(xNo)).Value) Then Workbooks(strname).Worksheets(System).Range(B8).Value = 二部 Exit For End If If (strProject = Workbooks().Worksheets(三部).Range(C amp。 CStr(xNo)).Value) Then Workbooks(strname).Worksheets(System).Range(B8).Value = 三部 Exit For End If If (strProject = Workbooks().Worksheets(四部).Range(C amp。 CStr(xNo)).Value) Then Workbooks(strname).Worksheets(System).Range(B8).Value = 四部 Exit For End If If (strProject = Workbooks().Worksheets(五部).Range(C amp。 CStr