Vba Excel宏暂停和恢复,或记住停止的位置

Vba Excel宏暂停和恢复,或记住停止的位置,vba,excel,Vba,Excel,我已经在Excel中制作了一个宏,它基本上将1个工作表中的所有数据外包,并将它们分离到它们所属的位置。但是,有时存在需要手动更正的错误值。如果手动更正,则在将数据重定向到单独的工作表的过程中会立即发现错误值 当找到这样一个值时,它旁边的单元格被标记为识别它是错误的,会为用户弹出一个警告,但我也希望代码暂停,让用户手动更改值,然后在准备好后恢复,这是我不确定如何暂停和恢复的部分 下面是操作的全部代码,还有另一个宏用于准备这些工作表,但目前这并不重要 Private Sub Zaradi_Click

我已经在Excel中制作了一个宏,它基本上将1个工作表中的所有数据外包,并将它们分离到它们所属的位置。但是,有时存在需要手动更正的错误值。如果手动更正,则在将数据重定向到单独的工作表的过程中会立即发现错误值

当找到这样一个值时,它旁边的单元格被标记为识别它是错误的,会为用户弹出一个警告,但我也希望代码暂停,让用户手动更改值,然后在准备好后恢复,这是我不确定如何暂停和恢复的部分

下面是操作的全部代码,还有另一个宏用于准备这些工作表,但目前这并不重要

Private Sub Zaradi_Click()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rngPlan As Range
    Dim pvtTable As PivotTable
    Dim pvtField As PivotField
    Dim pvtItem As PivotItem
    Dim i As Integer
    Dim vykon As Long
    Dim praca As String
    Dim meno As String
    Dim er As String
    Dim errArray(1 To 20) As String
    Dim mbResult As Integer
    Dim parySpolu As Integer

    Set wb = Workbooks("Zoznam plánov")

    er = "Nesedia páry!"

    mbResult = MsgBox("Tieto zmeny sú nezvratné. Potvrdte, že túto operáciu si prajete vykona?", _
    vbYesNoCancel)

    Select Case mbResult

        Case vbYes

            Workbooks("Kontrola plánov").Sheets("Summary").Activate

            meno = Workbooks("Kontrola plánov").Sheets("summary").Cells(2, 9)

            ' zoznam kontrolovanych planov
            Set rngPlan = Workbooks("Kontrola plánov").Sheets("Summary").Range(Cells(2, 1), Cells(10000, 1).End(xlUp))

            For i = 1 To rngPlan.Rows.Count ' pocet riadkov (size) kontrolovanych planov

                ' hodnota vykonu
                vykon = Workbooks("Kontrola plánov").Sheets("summary").Cells(i + 1, 6)
                ' co robil prace
                praca = Workbooks("Kontrola plánov").Sheets("summary").Cells(i + 1, 4)

                ' aktivuje pouzivany plan
                Set ws = wb.Sheets("Plán " & rngPlan(i))

                ws.Activate

                ' prida pracu
                ws.Cells(10000, 1).End(xlUp).Offset(1) = praca

                ' prida vykon
                ws.Cells(10000, 2).End(xlUp).Offset(1) = vykon

                ' prida meno
                ws.Cells(10000, 3).End(xlUp).Offset(1) = meno

                Set pvtTable = ws.PivotTables(1)
                Set pvtField = pvtTable.PivotFields(1)

                pvtTable.PivotCache.Refresh

                For j = 1 To pvtField.PivotItems().Count         

                    Set pvtItem = pvtField.PivotItems(j)                                    
                    pvtItem.ShowDetail = False                                        
                    ActiveSheet.PivotTables(1).NullString = "0"                                    
                    If pvtItem.Value = "(blank)" Then

                    Else
                        parySpolu = pvtTable.GetPivotData("Páry", "Práca", pvtField.PivotItems(j))
                        If parySpolu > ws.Cells(2, 7) Then
                            ws.Cells(j + 1, 11) = er
                            pvtItem.ShowDetail = True
                            MsgBox er
                        Else
                            ws.Cells(j + 1, 11) = "OK"
                        End If                             
                    End If
                Next j       
            Next i

            ' aktivuje sumarizaciu
            Workbooks("Kontrola plánov").Sheets("summary").Activate

        Case vbNo
            Exit Sub
        Case vbCancel
            Exit Sub
    End Select

    Workbooks("Kontrola plánov").Sheets(1).Activate
    MsgBox errNumbers

End Sub
发现错误值并给出警告的代码部分如下:

If parySpolu > ws.Cells(2, 7) Then
    ws.Cells(j + 1, 11) = er
    pvtItem.ShowDetail = True
    MsgBox er
Else
    ws.Cells(j + 1, 11) = "OK"
End If
我已经有了关于如何做到这一点的建议。一个是使用输入框,但我认为这对这种情况并不理想,因为用户希望正确地检查所有内容、源代码表、查找问题源等,因此我认为暂停和恢复会更好。另一个建议是采取如下措施:

已将公共LastCell检查为字符串

Sub Check_Someting()

    Dim cell As     Excel.Range
    Dim WS As       Excel.Worksheet

    If Not lastCellChecked = vbNullString Then Set cell = Evaluate(lastCellChecked)

    '// Rest of code...

    '// Some loop here I'm assuming...
    lastCellChecked = "'" & WS.Name & "'!" & cell.Address
    If cell.Value > 10 Then Exit Sub '// Lets assume this is classed as an error
    '// Rest of loop here...

    lastCellChecked = vbNullString
End Sub

存储出错前最后一个单元格的地址,并在下次运行时继续执行宏。如果未存储任何内容,则从开始运行宏。我认为这个解决方案更适合我的问题。然而,最后,我是一个非常没有经验的程序员,因此我想知道什么是最有效/最好的方法,对于我已经实现的代码的任何其他改进,我将不胜感激。

Excel是事件驱动的。没有事件=没有行动。因此,基本上,问题是触发代码继续的事件应该是什么

第一个选项是,正如您所指出的,您使用一个输入框或表单,一旦输入了更正,代码将继续。在这种情况下,有一个事件,单击按钮确认纠正值

如果希望允许用户对工作表本身进行更改,则除了捕获工作表更改事件外,没有其他事件可供使用。因此,基本上,如果存在需要更正的错误,您必须停止/停止代码,并将需要更正的单元格保存在某个隐藏的表格上。之后,您可以使用

Private Sub Worksheet_Change(ByVal Target As Range)

'Assuming that you "saved" the last position here:
'SomeHiddenSheet.Range("A1").value2 = "$D$10"  <-- this is the location where an error occurred which needed fixing

If Intersect(Target, SomeHiddenSheet.Range("A1").Value2) Is Nothing Then
    'The user did not change the requested cell but another
Else
    'The user change the cell
End If

End Sub

事件检查您请求的单元格是否已更改。但是有了这个解决方案,您就有了代码停止的问题。用户可以更改您要求他/她更改的单元格。但这并不能保证。事实上,用户可能决定更改另一个单元格,或者根本不做任何事情,只需保存/关闭文件。因此,使用此解决方案,您可能会再次重新检查所有先前的单元格。

使用全局变量,例如ProcessPaused为Boolean和:

修正完值a后

Sub corrected()
    ProcessPaused = False
End Sub
将使您的宏继续

根据您的案例实施,它将如下所示:

If parySpolu > ws.Cells(2, 7) Then
    ws.Cells(j + 1, 11) = er
    pvtItem.ShowDetail = True
    MsgBox er
    ProcessPaused = True
    Do While ProcessPaused
        DoEvents
    Loop
Else
    ws.Cells(j + 1, 11) = "OK"
End If
当然,您还需要放置一个巨大的按钮:

Sub PokracovatVProcese_Click()
    ProcessPaused = False
End Sub

我认为停止/恢复宏以允许人工干预没有任何意义,因为宏的目的是使事情自动化。如果人类需要干预,她不妨重新运行宏,让它检查所需的整个范围

如果您有性能问题,例如,因为您的内部有大量数据,您可能需要优化代码


因此,我希望您在出现错误时用消息停止宏执行!警告用户不受欢迎的数据,或者-更好-确保在问题发生之前检查错误。

在您通过运行“更正”触发继续之前,宏实际上会停止,这可能是一个按钮单击或工作表更改事件。我假设您可能需要在其他位置查找该值/使用其他值进行检查。确保在给定的宏中启用屏幕更新,因为它没有被禁用,所以这无关紧要。
Sub PokracovatVProcese_Click()
    ProcessPaused = False
End Sub