根據每張紙上的單元格值一次選擇和列印多張紙

我有一個包含 500 WorkSheets 的檔案，并嘗試將 G1 = "Print" 的所有檔案列印為單個檔案。

我的步驟是創建一個陣列并存盤匹配的作業表名稱。接下來是從陣列中選擇該作業表并列印它們。

Sub Help()

 Dim MyArray() As Variant
 Dim I As Long
 Dim MyArray_Count As Integer
   MyArray_Count = 0

 Worksheet_Count = ActiveWorkbook.Worksheets.Count

 For I = 1 To Worksheet_Count
   If Worksheets(I).Range("G1").Value = "Print" Then
       MyArray_Count = MyArray_Count   1
       MyArray(MyArray_Count) = ActiveWorkbook.Worksheets(I).Name ' 'Having error here
   End If

 Next I

 Worksheets(MyArray).Select 'having error here

 End Sub

uj5u.com熱心網友回復：

有很多方法可以做到這一點，但您缺少的重要部分是Redim Preserve.

我改變了一些東西以保持簡單。我試圖緊緊抓住你的設計。如您所見，您還必須計劃當它們都不滿足條件時會發生什么。

Sub Help()
  Dim ws As Worksheet
  Dim MyArray() As String
  ReDim MyArray(0)

  For Each ws In ActiveWorkbook.Worksheets
    If ws.Range("G1").Value = "Print" Then
      If Len(MyArray(0)) > 0 Then ReDim Preserve MyArray(UBound(MyArray)   1)
      MyArray(UBound(MyArray)) = ws.Name
    End If
  Next

  If Len(MyArray(0)) > 0 Then
     ActiveWorkbook.Worksheets(MyArray).Select
  Else
     MsgBox "none found"
  End If
 
End Sub

_{注意：請記住，單元格中的“列印”與“列印”或“列印”不同}

這是一個更好的If宣告來解決這個問題：

If UCase$(Trim$(ws.Range("G1").Value)) = "PRINT" Then

uj5u.com熱心網友回復：

字典 vs 陣列

字典

• 您不知道將添加多少作業表，因此使用字典提供了更合適（更簡單）的解決方案。此外，使用For Each...Next回圈使其更具可讀性，并強調作業表的數量無關緊要。

Option Explicit

Sub HelpDictionary()

    Dim wb As Workbook: Set wb = ActiveWorkbook
    ' If you're dealing with the workbook containing this code, instead use:
    'Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    
    Dim ws As Worksheet
    Dim cString As String
    
    ' Add the worksheet names to the dictionary.
    For Each ws In wb.Worksheets
        cString = CStr(ws.Range("G1").Value)
        If StrComp(cString, "Print", vbTextCompare) = 0 Then ' 'PRINT = print'
            dict(ws.Name) = Empty ' only interested in the keys
        End If
    Next ws
    
    ' Check if any worksheet name was added.
    If dict.Count = 0 Then ' no worksheet name added
        MsgBox "No worksheets to select.", vbExclamation
        Exit Sub
    'Else ' at least one worksheet name was added
    End If
    
    wb.Worksheets(dict.Keys).Select

    MsgBox "The following worksheets are selected: " _
        & vbLf & Join(dict.Keys, vbLf), vbInformation
    
End Sub

大批

• 這也是一個有效的解決方案。將它與字典解決方案進行比較，看看它是如何更復雜的。

Sub HelpArray()

    Dim wb As Workbook: Set wb = ActiveWorkbook
    ' If you're dealing with the workbook containing this code, instead use:
    'Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim aCount As Long: aCount = wb.Worksheets.Count
    
    Dim MyArray() As String: ReDim MyArray(1 To aCount) ' to fit 'a'll names
    
    Dim cString As String
    Dim a As Long ' 'a'll worksheets
    Dim p As Long ' worksheets to 'p'rint
    
    ' Add the worksheet names to the array.
    For a = 1 To aCount
        cString = CStr(Worksheets(a).Range("G1").Value)
        If StrComp(cString, "Print", vbTextCompare) = 0 Then ' 'PRINT = print'
            p = p   1
            MyArray(p) = wb.Worksheets(a).Name
        End If
    Next a
    
    ' Check if any worksheet name was added.
    If p = 0 Then ' no worksheet name added
        MsgBox "No worksheets to select.", vbExclamation
        Exit Sub
    'Else ' at least one worksheet name was added
    End If
    
    ' Resize if not all worksheet names.
    If p < aCount Then ' not all worksheet names added
        ReDim Preserve MyArray(1 To p)
    'Else ' all worksheet names added
    End If
    
    wb.Worksheets(MyArray).Select

    MsgBox "The following worksheets are selected: " _
        & vbLf & Join(MyArray, vbLf), vbInformation
    
End Sub

標籤：擅长 vba

上一篇：選擇多列以在VBA中表現出色

下一篇：如何在組合框vba中過濾資料