我如何重构我的macros? 多个.Find和.FindNext导致错误(VBA)

我试图创build一个新的macros,通过主工作簿中各种任务的主分配列表来查看,然后为不同工作簿中的一个工作表中的个人填充待办事项列表,并提供关于这些分配的信息,从主工作簿中拉出来。

直到我添加了另外一个Find函数,它现在正在进行,现在抛出错误。 通过一些研究,我已经意识到这是因为我有两个Find函数,这些函数很可能会破坏FindNext的上下文。 所以,我有点理解这个理论,但是我不知道如何解决这个问题。

有什么替代品让我的代码工作?

这里是屏幕截图和上下文的代码:

在这里输入图像说明

^主要工作簿,与张恐惧,性别,愉快,RBL和WholeReport有主题的信息

在这里输入图像说明

^个人待办事项清单

在这里输入图像说明 ^个人清洁笔记日志

码:

Sub FindTest() Dim wbMaster As Workbook Dim wbIndiv As Workbook Dim wsMaster, wsIndiv As Worksheet Dim wsICleaning As Worksheet Dim LastRow As Long Dim LastRowIndiv, LastRowIClean As Long Dim FoundRow, FoundCol As Long Dim FoundRow2 As Long Dim firstCellAddress As String Dim rgSearch As Range Dim aCell As Range Dim bCell As Range Dim MergeID As String Dim sourcePath As String: sourcePath = "C:\Cleaning_Notes_testing\" Dim strIndiv(1 To 3) As String Dim i, e Dim TaskString As String Set wbMaster = ActiveWorkbook Set wsMaster = wbMaster.Sheets("Data Tracking Log") LastRow = Range("A5000").End(xlUp).Row strIndiv(1) = "Christie" strIndiv(2) = "Brittany" strIndiv(3) = "Adeeb" For Each i In strIndiv If i <> "" Then With Workbooks.Open(sourcePath & "Cleaning_notes_" & i & ".xlsx") Debug.Print i Set wbIndiv = ActiveWorkbook Set wsIndiv = wbIndiv.Sheets("To-Do") Set wsICleaning = wbIndiv.Sheets("Cleaning Notes") ' Get search range Set rgSearch = wsMaster.Range("E1:L" & LastRow) Set aCell = rgSearch.Find(i) ' If not found then exit If aCell Is Nothing Then Debug.Print "Not found" Exit Sub End If ' Store first aCell address firstCellAddress = aCell.Address Debug.Print firstCellAddress ' Find all cells containing Name Do Debug.Print "Found: " & aCell.Address 'Populate To-Do FoundRow = aCell.Row Debug.Print "FoundRow: " & FoundRow FoundCol = aCell.Column Debug.Print "Found Col: " & FoundCol Set aCell = rgSearch.FindNext(After:=aCell) Debug.Print "Found: " & aCell.Address wsIndiv.Activate LastRowIndiv = wsIndiv.Range("A5000").End(xlUp).Row + 1 wsIndiv.Range("A" & LastRowIndiv).Value = wsMaster.Range("A" & FoundRow).Value wsIndiv.Range("B" & LastRowIndiv).Value = wsMaster.Range("C" & FoundRow).Value wsIndiv.Range("C" & LastRowIndiv).Value = wsMaster.Range("D" & FoundRow).Value wsIndiv.Range("D" & LastRowIndiv).Value = wsMaster.Cells(1, FoundCol).Value MergeID = wsIndiv.Range("A" & LastRowIndiv).Value Debug.Print MergeID TaskString = wsMaster.Cells(1, FoundCol).Value Debug.Print TaskString 'Populate indiv Cleaning Notes If TaskString = "Fear" Or TaskString = "Gender" Or TaskString = "Happy" Or TaskString = "RBL" Or TaskString = "WholeReport" Then wsICleaning.Activate LastRowIClean = Range("A5000").End(xlUp).Row + 1 wsICleaning.Range("A" & LastRowIClean).Value = wsMaster.Range("A" & FoundRow).Value wsICleaning.Range("B" & LastRowIClean).Value = wsMaster.Range("C" & FoundRow).Value wsICleaning.Range("C" & LastRowIClean).Value = wsMaster.Range("D" & FoundRow).Value wsICleaning.Range("D" & LastRowIClean).Value = TaskString wbMaster.Sheets(TaskString).Activate Set bCell = ActiveSheet.Columns(1).Find(What:=MergeID, LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) FoundRow2 = bCell.Row Debug.Print "FoundRow2: " & FoundRow2 Debug.Print ActiveSheet.Range("G" & FoundRow2).Value wsICleaning.Range("E" & LastRowIClean).Value = ActiveSheet.Range("G" & FoundRow2).Value End If wsMaster.Activate Loop While firstCellAddress <> aCell.Address End With End If Next i End Sub 

感谢您的时间!

您在循环结束检查之前缺lessFind()

  Set aCell = rgSearch.Find(What:=i, After:=aCell) Loop While firstCellAddress <> aCell.Address