Как заставить всплывающее окно сообщения отображать все значения, которые соответствуют запросу в рабочей книге? - PullRequest
0 голосов
/ 03 мая 2019

У меня есть список элементов, который выглядит в Excel следующим образом:

List of Items

Этот список затем используется в качестве ссылки для моих таблиц в других нескольких листах и ​​файлах Excel:

Table in multiple sheets

Формула в столбце B: (Если A в списке, «Удалить», «Сохранить»). Я построил макрос, который будет перебирать столбец B и избавляться от всей строки, если в качестве значения будет Delete. поэтому в этом примере строка с номером 5 будет удалена, если я нажму на синюю кнопку.

Вот мой код для этого (работает для всех листов в рабочей книге):

Option Explicit
Sub WorksheetLoop()

Dim i As Long
Dim ws As Worksheet
Dim Last As Long

    For Each ws In ThisWorkbook.Worksheets
        With ws
            Last = .Cells(.Rows.Count, "B").End(xlUp).Row
            For i = Last To 1 Step -1
                if (.Cells(i, "B").Value) = "Delete" Then
                    .Cells(i, "B").EntireRow.Delete
                End If
            Next i
        End With
    Next ws

End Sub

Теперь мне нужны дополнительные строки кода VBA, которые позволят Excel просмотреть все рабочие листы в книге и открыть окно сообщения, показывающее, какие записи соответствуют списку на первом изображении. Если совпадений нет, то покажите «Записи не найдены».

Ниже приведена структура кода, который я пробовал, но я не мог найти правильный способ сделать это. Я также поместил это как отдельный макрос-модуль, чтобы сначала щелкнуть по нему, прежде чем удалять строки, соответствующие списку.

Private Sub Worksheet_Change(ByVal Target As Range)
   If Range ="List" Then
         MsgBox ""
   Else MsgBox "No match found."
   End If
End Sub

Может кто-нибудь помочь с этим?

1 Ответ

2 голосов
/ 03 мая 2019

Поместит мой комментарий как ответ, так как чтение кода оттуда ужасно:

Dim i As Long, ws As Worksheet, Last As Long, x as long, z as string
For Each ws In ThisWorkbook.Worksheets
    With ws
        Last = .Cells(.Rows.Count, "B").End(xlUp).Row
        For i = Last To 1 Step -1
            if (.Cells(i, "B").Value) = "Delete" Then
                z = z & ", " & .Cells(i,1).Value
                x = x + 1
            End If
        Next i
    End With
Next ws
If x > 0 then
    MsgBox "The following names will be deleted: " & z
    Application.Run "WorksheetLoop" 'Will run the delete code after names are found
Else
    MsgBox "No match found."
End If
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...