Question

我在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

我已经有了如何做到这一点的建议。一个是使用InputBox，但我认为这对于这种情况并不理想（因为用户更愿意正确检查所有内容，源表，找到问题的根源等），因此暂停＆amp;我认为恢复会更好。另一个建议是做类似的事情：

Public lastCellChecked As String

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

存储错误之前的最后一个单元格的地址，并且宏在下一次运行时从那里开始继续（如果没有存储，则从头开始运行）。我认为这个解决方案更适合我的问题。但是，最后，我是一个非常缺乏经验的“程序员”，所以想知道什么是最有效/最好的方式（对我已经实现的代码的任何其他改进将不胜感激）。

Answer 1

Excel是事件驱动的。没有事件=没有行动。所以，基本上，问题是事件应该触发代码的“延续”。

第一个选项是（正如您所指出的）您使用输入框或表单，一旦输入更正，代码就会继续。在这种情况下，有一个事件“点击一个按钮”来确认纠正值。

如果您想允许用户在工作表本身上进行更改，则不会使用其他事件，而是捕获“Worksheet_Change”事件。所以，基本上如果有一个需要纠正的错误，你将不得不停止/停止代码（并保存一些隐藏的表格，哪个单元格需要更正）。之后你可以使用

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

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

Answer 2

使用全局变量，例如 ProcessPaused As Boolean 和：

ProcessPaused = True
Do While ProcessPaused
    DoEvents
Loop

一旦你完成了修正值

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

Answer 3

我认为停止/恢复宏以允许人为干预是没有意义的，因为宏意味着自动化事物。如果一个人需要干预，他也可以重新运行宏来让它检查所需的整个范围。

如果您遇到性能问题（例如，因为内部有大量数据），您可能需要优化代码。

所以，我宁愿你在出错时停止宏执行，并在消息（！）警告用户提供不受欢迎的数据，或 - 更好 - 确保在出现问题之前检查错误。

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

3 个答案: