“For Each”循环保持循环通过“If”条件

我使用VBA将Outlook中的电子邮件转换为Excel，并将电子邮件的主题行与另一个工作表上的一系列单元格进行比较。 我正在使用一个For Each循环来实现这一点，但似乎当我的条件符合，它继续下去，所以它不会发布我想要的结果。 它似乎循环了我已经定义的范围内的所有单元格，但是，即使它满足我的条件，它仍然继续，最终成为空白。

在这里我正在定义我的范围：

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

这是我的For Each循环：

 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是电子邮件项目的计数器。

有更好的方法吗？

Answer 1

编辑2：仍然猜测一下…

 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