Цикл «Для каждого» сохраняет циклическое прошлое «Если»

Я вытаскиваю электронные письма из Outlook в Excel с помощью VBA, сравнивая строку темы письма с диапазоном ячеек на другом листе. Я использую цикл For Each для достижения этого, но кажется, что, когда мое условие if выполнено, оно продолжается, поэтому оно не публикует результат, который я хочу. Кажется, что все ячейки в диапазоне, который я определил, пересекают, но тогда, даже когда он удовлетворяет моему условию if, он продолжает двигаться и заканчивается пустым.

Здесь я определяю свои диапазоны:

Dim rRng As Range, cel As Range Set rRng = Sheet2.Range("A2:A1218") 

Вот мой цикл For Each:

• Можете ли вы расширить формулу sumifs, зависящую от оператора if?
• Excel. Если слово присутствует, поверните число до 0?
• Как упорядочить данные таблицы по-разному, используя if, match и index?
• Excel multiple If (Isnumber (поиск)
• Как сделать заявление IF с OR и пустой ячейкой в ​​Excel VBA

 oRow = 1 For iRow = 1 To Folder.Items.Count 'This loops through the inbox items. If VBA.DateValue(VBA.Now) - 1 <= VBA.DateValue(Folder.Items.Item(iRow).ReceivedTime) And VBA.DateValue(VBA.Now) > VBA.DateValue(Folder.Items.Item(iRow).ReceivedTime) Then 'This is checking that the emails were received within a certain time frame. For i = 0 To UBound(emails) If StrComp(Folder.Items.Item(iRow).SenderEmailAddress, emails(i)) = 0 Then 'This is checking that the emails are coming from specific address', emails is an array of accepted address'. For Each cel In rRng.Cells 'The beggining of my for each If InStr(1, Folder.Items.Item(iRow).Subject, cel.Text) > 0 Then 'checking to see if my the content from one of the cells in the range is part of the subject from the emails. ThisWorkbook.Sheets(1).Cells(oRow, 3) = cel.Value 'If it is part of the subject, take the value from the cell in the range where it matches, and put that value in another cell. End If Next cel oRow = oRow + 1 ThisWorkbook.Sheets(1).Cells(oRow, 1).Select ThisWorkbook.Sheets(1).Cells(oRow, 1) = Folder.Items.Item(iRow).ReceivedTime ThisWorkbook.Sheets(1).Cells(oRow, 5) = Folder.Items.Item(iRow).SenderEmailAddress ThisWorkbook.Sheets(1).Cells(oRow, 6) = Folder.Items.Item(iRow).Subject ThisWorkbook.Sheets(1).Cells(oRow, 7) = Folder.Items.Item(iRow).Body 'All of this above code is inserting data from the emails into cells. End If Next i End If Next iRow 

oRow – это счетчик для строк в листе excel.

iRow – это счетчик для элементов электронной почты.

Есть ли еще лучший подход?

 Dim itm As Object '<<< this makes your code more readable... Dim rw as range Set rw = ThisWorkbook.Sheets(1).Rows(1) For iRow = 1 To Folder.Items.Count Set itm = Folder.Items.Item(iRow) If Now - 1 <= itm.ReceivedTime Then For i = 0 To UBound(emails) If StrComp(itm.SenderEmailAddress, emails(i)) = 0 Then For Each cel In rRng.Cells If InStr(1, itm.Subject, cel.Text) > 0 Then rw.Cells(3).Value = cel.Value Exit For 'exit loop over cells End If 'subject match Next cel 'record the other details rw.Cells(1).Value = itm.ReceivedTime rw.Cells(5).Value = itm.SenderEmailAddress rw.Cells(6).Value = itm.Subject rw.Cells(7).Value = itm.Body Set rw = rw.Offset(1, 0) Exit For 'exit loop over emails End If 'email match Next i End If Next iRow