Question

下面的两个模块总是循环运行。我希望第二个模块用于验证在第一个模块运行后创建记录，因为所有用户看到的都是问题，但不是结果。

第一个模块检测何时将新行添加到表中并询问您是否要将数据导出到另一个工作表：

Sub NewDatabaseEntry() 

Dim sh As Worksheet
Dim rspn As VbMsgBoxResult

rspn = MsgBox("Do you want to create a project? If you did not add a new row, click No", vbYesNo)
If rspn = vbNo Then Exit Sub       
        Range("MasterTemplate").Copy
        Sheets("Database").Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteFormulas

FindProjectName 'A macro that literally finds the name of the project...
'FindRow
End Sub

然后，该模块查看目标工作表上的行号，然后将该行号值复制到预定义的范围。

Sub FindRow()

    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Projects").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
    Dim foundRng As Range
    For Each rng In Sheets("Projects").Range("B2:B" & LastRow)
        Set foundRng = Sheets("Database").Range("C:C").Find(rng, LookIn:=xlValues, lookat:=xlWhole)
        If Not foundRng Is Nothing Then
            rng.Offset(0, -1) = foundRng.Row
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

FindRow工作的唯一方法是将其放入ThisWorkbook~ Excel Object. If I place it anywhere else, it gets into a loop with the NewDatabaseEntry module where it keeps asking you if you想要创建新项目时。我希望用户知道创建条目时无需关闭工作簿然后重新打开它，只是为了验证他们的记录放在哪个行号。

我有什么遗失的吗？

Answer 1

既然你提到这会陷入一个无限循环，问他们是否想要创建一个新项目，我相信原因是因为你有一个Worksheet_Change事件（或类似事件），当你发起时在Projects工作表中添加一个值。

当您FindProject事件所需的同一工作表上有Worksheet_Change个操作数据时，会出现此问题。

所以我认为你应该做的是关闭事件直到FindProject完成（顺便说一句，我建议将FindProject更改为其他内容，因为它不仅仅是“找到一个项目” ）。

Sub FindRow()
    Application.ScreenUpdating = False
    Application.EnableEvents = False ' ADDED THIS
    Dim LastRow As Long
    LastRow = Sheets("Projects").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
    Dim foundRng As Range
    For Each rng In Sheets("Projects").Range("B2:B" & LastRow)
        Set foundRng = Sheets("Database").Range("C:C").Find(rng, LookIn:=xlValues, lookat:=xlWhole)
        If Not foundRng Is Nothing Then
            rng.Offset(0, -1) = foundRng.Row
        End If
    Next rng
    Application.EnableEvents = True ' ADDED THIS
    Application.ScreenUpdating = True
End Sub

模块Excel VBA之间的冲突

1 个答案: