Блог

У меня есть документ с более чем 500 листами, и я пытаюсь распечатать все те, где G1 = «Печать», как один документ.

Мои шаги состоят в том, чтобы создать массив и сохранить соответствующие имена листов. Далее необходимо выбрать эти листы из массива и распечатать их.

 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  

Есть много способов сделать это, но вам не хватает одной важной детали 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)) gt; 0 Then ReDim Preserve MyArray(UBound(MyArray)   1)  MyArray(UBound(MyArray)) = ws.Name  End If  Next   If Len(MyArray(0)) gt; 0 Then  ActiveWorkbook.Worksheets(MyArray).Select  Else  MsgBox "none found"  End If   End Sub  

_{Примечание: Имейте в виду, что «Печать» в вашей ячейке-это не то же самое, что «печать» или «ПЕЧАТЬ».}

Вот лучшее If заявление для решения этой проблемы:

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

Словарь против массива

Словарь

• Вы не знаете, сколько листов будет добавлено, поэтому использование словаря представляет собой более подходящее (простое) решение. Кроме того, использование 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: " _  amp; vbLf amp; 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 lt; 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: " _  amp; vbLf amp; Join(MyArray, vbLf), vbInformation   End Sub