从清单中排除WorkBook
我试图通过从工作簿列表中排除工作簿本身的特定名称来更好地在工作表中进行macros工作。 我试图进入一个如果像声明，但我无法弄清楚确切的语法/在哪里添加它不会与其余的macros冲突。
当前macros
Sub BrowseWorkbooks() Const nPerColumn As Long = 38 'number of items per column Const nWidth As Long = 13 'width of each letter Const nHeight As Long = 18 'height of each row Const sID As String = "___SheetGoto" 'name of dialog sheet Const kCaption As String = " Select Workbook" 'dialog caption Dim i As Long Dim TopPos As Long Dim iBooks As Long Dim cCols As Long Dim cLetters As Long Dim cMaxLetters As Long Dim cLeft As Long Dim thisDlg As DialogSheet Dim CurrentSheet As Worksheet Dim cb As OptionButton Application.ScreenUpdating = False If ActiveWorkbook.ProtectStructure Then MsgBox "Workbook is protected.", vbCritical Exit Sub End If On Error Resume Next Application.DisplayAlerts = False ActiveWorkbook.DialogSheets(sID).Delete Application.DisplayAlerts = True On Error GoTo 0 Set CurrentSheet = ActiveSheet Set thisDlg = ActiveWorkbook.DialogSheets.Add With thisDlg .Name = sID .Visible = xlSheetHidden 'sets variables for positioning on dialog iBooks = 0 cCols = 0 cMaxLetters = 0 cLeft = 78 TopPos = 40 For i = 1 To Workbooks.Count If i Mod nPerColumn = 1 Then cCols = cCols + 1 TopPos = 40 cLeft = cLeft + (cMaxLetters * nWidth) cMaxLetters = 0 End If Set CurrentWorkbook = Workbooks(i) cLetters = Len(CurrentWorkbook.Name) If cLetters > cMaxLetters Then cMaxLetters = cLetters End If iBooks = iBooks + 1 .OptionButtons.Add cLeft, TopPos, cLetters * nWidth, 16.5 .OptionButtons(iBooks).Text = _ Workbooks(iBooks).Name TopPos = TopPos + 13 Next i .Buttons.Left = cLeft + (cMaxLetters * nWidth) + 24 CurrentWorkbook.Activate With .DialogFrame .Height = Application.Max(68, _ Application.Min(iBooks, nPerColumn) * nHeight + 10) .Width = cLeft + (cMaxLetters * nWidth) + 24 .Caption = kCaption End With .Buttons("Button 2").BringToFront .Buttons("Button 3").BringToFront Application.ScreenUpdating = True If .Show Then For Each cb In thisDlg.OptionButtons If cb.Value = xlOn Then 'Store the name of the Woorkbook to use it later SelectedWorkBookName = cb.Caption Exit For End If Next cb Else MsgBox "Nothing selected" Exit Sub End If Application.DisplayAlerts = False .Delete Set wbook = Workbooks(SelectedWorkBookName) wbook.Activate ActiveSheet.Unprotect Range("A1:P91").Select Selection.Copy Windows("Phoenix Remote Reconcile.xlsm").Activate Sheets("Paste Here").Select Cells.Select ActiveSheet.Paste Sheets("Start-End").Select End With End Sub 我正在寻找补充
If Workbook(i).Name Like "*Phoenix Remote Reconcile" Then 'Do Nothing Else
更新： …
For i = 1 To Workbooks.Count wbName = Workbooks(i).Name If Not wbName Like "*Phoenix Remote Reconcile*" Then iBooks = iBooks + 1 If iBooks Mod nPerColumn = 1 And iBooks > 1 Then cCols = cCols + 1 TopPos = 40 cLeft = cLeft + (cMaxLetters * nWidth) cMaxLetters = 0 End If cMaxLetters = Application.Max(Len(wbName), cMaxLetters) .OptionButtons.Add cLeft, TopPos, cLetters * nWidth, 16.5 .OptionButtons(iBooks).Text = _ Workbooks(iBooks).Name TopPos = TopPos + 13 End If Set CurrentWorkbook = Workbooks(i) cLetters = Len(CurrentWorkbook.Name) If cLetters > cMaxLetters Then cMaxLetters = cLetters End If ....
Dim wbName as String '...... For i = 1 To Workbooks.Count wbName = Workbooks(i).Name If Not wbName like "*Phoenix Remote Reconcile*" Then iBooks = iBooks + 1 'don't use i below, since you're not adding every workbook... If iBooks Mod nPerColumn = 1 And iBooks > 1 Then '<<EDIT cCols = cCols + 1 TopPos = 40 cLeft = cLeft + (cMaxLetters * nWidth) cMaxLetters = 0 End If cMaxLetters = Application.Max(Len(wbName), cMaxLetters)'<EDIT .OptionButtons.Add cLeft, TopPos, cLetters * nWidth, 16.5 .OptionButtons(iBooks).Text = wbName '<<EDIT TopPos = TopPos + 13 End If 'not skipping this workbook Next i '....
你的意思是工作簿或工作表？ 无论哪种方式，它是这样的：
If InStr(Sheets(i).Name, "Phoenix Remote Reconcile") > 0 ''found it else ''not there endif
注意你可能想用UCASE（）或LCASE（）来包围它们，因为VBA在匹配上是区分大小写的。