Выделите, какие листы в Excel 2016 содержат положительное значение в определенной ячейке

Question

У меня есть набор из нескольких сотен одинаково выложенных листов, но каждый из них содержит разные данные. Я хочу перечислить все листы, где, например, ячейка E532 = 1 или E532> 0. Можно ли это сделать? И если да, то как? Если это поможет, у меня установлен Kutools.

Большое спасибо.

Answer 1

Следующая подпроцедура VBA идентифицирует имена рабочих листов в активной рабочей книге, которые содержат значение больше 0 в ячейке E532. Имена рабочих листов будут выведены в окно «Немедленно». Кроме того, цвет вкладки рабочего листа будет изменен на желтый.

Sub ListWorksheets()

For Each ws In Worksheets
    TestValue = ws.Range("E532").Value
    If (TestValue > 0) Then
      Debug.Print ws.Name
      ws.Tab.ColorIndex = 6
    End If
Next ws

End Sub

Чтобы создать список рабочих листов, соответствующих критериям, создайте новый рабочий лист и запустите следующий макрос. Список рабочих листов будет выводиться, начиная с ячейки, которая активна при запуске макроса.

Sub ListWorksheetsAtActiveColumn()

'Defines the row offset of the current cell to list the worksheets
Dim RowNumber As Long

RowNumber = 0

For Each ws In Worksheets
    TestValue = ws.Range("E532").Value
    If (TestValue > 0) Then
      Debug.Print ws.Name
      'Changes the color of the worksheet tab to yellow
      ws.Tab.ColorIndex = 6
      'Creates a list of worksheet names that meet the test starting
      'at the current cell
      ActiveCell.Offset(RowNumber, 0).Value = ws.Name
      RowNumber = RowNumber + 1
    End If
Next ws

End Sub

Answer 2

Попробуйте это:

Sub LookFor()
    Dim msg As String, addy As String, v As Variant
    Dim w As Worksheet
    msg = ""
    addy = Application.InputBox(Prompt:="enter cell address", Type:=2)
    v = Application.InputBox(Prompt:="enter cell value", Type:=3)

    For Each w In Worksheets
        If w.Range(addy) = v Then
            msg = msg & vbCrLf & w.Name
        End If
    Next

    If msg = "" Then
        MsgBox "nothing found"
    Else
        MsgBox msg
    End If
End Sub