Question

我正在尝试创建一个新的宏，它通过主工作簿中的各种任务的主要分配列表，然后在不同工作簿中的一个工作表上填充个人的待办事项列表，并提供有关的信息从主工作簿中提取这些作业。

在我添加另一个Find函数之前一直顺利，现在它正在抛出错误。通过一些研究，我意识到这是因为我有两个Find函数可能会破坏FindNext的上下文。所以，我有点理解这个理论，但我不知道如何实际修复它。

有什么方法可以让我的代码正常工作？

以下是截图和上下文代码：

^主工作簿，包含恐惧，性别，快乐，RBL和WholeReport，其中包含有关主题的信息

^ Indiv待办事项列表

^ Indiv清洁笔记日志

代码：

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

感谢您的时间！

Answer 1

在循环结束检查之前，你错过了Find()

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

如何重构我的宏？ Multiple.Rend和.FindNext导致错误（VBA）

1 个答案: