Проходить по ячейкам и отображать сообщение, если значение не найдено - PullRequest
0 голосов
/ 08 июля 2019

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


Sub MarkXfer_noX()

Dim rng As Range
Dim rng2 As Range
Set rng = Worksheets("Transferred Routings").UsedRange
Dim i As Integer
Dim j As Integer
Dim ProdCI As String
Dim found As Boolean
Dim intRowCount As Integer


intRowCount = Sheets("Transferred Routings").UsedRange.Rows.count

For i = 2 To intRowCount

        If rng.Cells(i, 1) <> "" Then ProdCI = rng.Cells(i, 1) 'get the ProdCI number from column A if not blank
        Worksheets("All_ProCI").Activate 'activate main page
        Set rng2 = Worksheets("All_ProCI").UsedRange 'select a range on the main page

            For j = 2 To rng2.Rows.count 'from row 2 to the end
                If rng2.Cells(j, 2) = ProdCI Then 'if the ProdCI in column B matches the one we picked,
                    Call FillCell(j) 'call a sub in a different module and give it our current row
                    found = True
                Else
                    found = False
                End If
            Next

   Next

   If found = False Then
   MsgBox (ProdCI & " not found") 'Display a message if one of the items wasn't found on the main page. Currently has an error where the last one in the list always pops up.
   Else
   End If

End Sub

Сейчас он всегда показывает сообщение msgbox с последним значением в диапазоне, независимо от того, что.

1 Ответ

0 голосов
/ 08 июля 2019

Спасибо всем, вот обновленный рабочий код с использованием функции Find

Sub MarkXfer_Find()

'Re-tooled to use the .Find function instead of looping through each
Dim rng As Range
Dim rng2 As Range
Set rng = Worksheets("Transferred Routings").UsedRange
Dim i As Integer
Dim ProdCI As String
Dim intRowCount As Integer
Dim intRowCount2 As Integer
Dim aCell As Range

intRowCount = Sheets("Transferred Routings").UsedRange.Rows.count

For i = 2 To intRowCount

        If rng.Cells(i, 1) <> "" Then ProdCI = rng.Cells(i, 1) 'get the ProdCI number from column A if not blank
        Worksheets("All_ProCI").Activate 'activate main page
        Set rng2 = Worksheets("All_ProCI").UsedRange 'select a range on the main page
        intRowCount2 = Worksheets("All_ProCI").UsedRange.Rows.count

        'use the Find function to put a value in aCell
        Set aCell = rng2.Range("B1:B" & intRowCount2).Find(What:=ProdCI, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

        If Not aCell Is Nothing Then
            'MsgBox ProdCI & " found"
            Call FillCell(aCell.row)

        Else 'If aCell is blank display msgbox
        MsgBox "ProdCI """ & ProdCI & """ not found"
        End If

Next


End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...