Question

要删除名称并关联工作簿的每张工作表中同一行中的数据，用户需要突出显示名称并单击第一个工作表上的按钮。然后会弹出一个确认窗口，询问他们是否确定。如果他们点击否，一切都会受到保护并且工作正常。如果他们单击“是”，则所有工作表都不受保护，并出现第二个确认窗口 - 如果第二次单击“是”，则会从每个工作表中删除数据，删除后一切都将受到保护。但是，如果第二次点击“否”，我就无法获取代码，然后在退出子目录之前保护所有内容。

感谢任何帮助，以及有关资源的建议，以帮助我自己变得更加熟练。：）

以下是代码：

Sub DeleteRow()
'this macro deletes the row for a selected patient from worksheet of selected month and all months after that

    'variables
    Dim PatientName As String, PatientRow As Long, w As Long
    Dim pRow As Long, lRow As Long, LookUpRng As Range, answer As Long
    Dim rArray() As Variant, sArray As Variant
    ReDim rArray(0)
    ReDim sArray(0)


With ActiveSheet
ActiveSheet.Unprotect "arafluid"
    PatientName = .Range("d" & ActiveCell.Row)
    PatientRow = ActiveCell.Row
    .Rows(PatientRow).Interior.ColorIndex = 4



    'check that user want has selected correct patient
    answer = MsgBox("Do you want to permanently remove patient " & vbCr & vbCr & _
        PatientName & " from ALL months in this workbook?", vbYesNo, "Confirmation")
            .Rows(PatientRow).Interior.ColorIndex = -4142
                If answer = vbNo Then ActiveSheet.Protect "arafluid"
                If answer <> vbYes Then Exit Sub


    'check that it is safe to delete rows in future sheets
    For w = Worksheets.Count To ActiveSheet.Index Step -1

        With Sheets(w)
        Sheets(w).Unprotect "arafluid"
            pRow = 0
            lRow = .Range("d10").CurrentRegion.Rows.Count + 9
            Set LookUpRng = .Range("d10" & ":d" & lRow)

            On Error Resume Next
                pRow = Application.WorksheetFunction.Match(PatientName, LookUpRng, 0) + 9
                    If Err.Number <> 0 Then
                        Trail = Trail & vbCr & "  " & .Name & " Not Found!"
                    Else
                        Trail = Trail & vbCr & "  " & .Name & " ok"
                        ' add value on the end of the arrays
                        ReDim Preserve rArray(UBound(rArray) + 1) As Variant
                        ReDim Preserve sArray(UBound(sArray) + 1) As Variant
                        rArray(UBound(rArray)) = pRow
                        sArray(UBound(sArray)) = w
                    End If
            On Error GoTo 0
                End With
    Next w
        'check that user still wants to delete
        answer = MsgBox("Once deleted, the information cannot be recovered. Click YES to permanently remove: " & vbCr & vbCr & _
               PatientName & vbCr, vbYesNo, "Are you sure?")
                        If answer <> vbYes Then Exit Sub
                        If answer <> vbNo Then
                        For a = Worksheets.Count To ActiveSheet.Index Step -1
                        Sheets(a).Protect "arafluid"
                        Next a
                        End If



    'delete rows for selected patient

    For d = 1 To UBound(sArray)
        Sheets(sArray(d)).Rows(rArray(d)).EntireRow.Delete
    Next d

End With

'loop through all sheets in the workbook.
For w = 1 To Sheets.Count
Sheets(w).Protect "arafluid"
Next w


End Sub

Answer 1

如果用户说“不”，则退出Sub。在第二个MessageBox之后更改这些行：

answer = MsgBox("Once deleted, the information cannot be recovered. Click YES to permanently remove: " & vbCr & vbCr & _
     PatientName & vbCr, vbYesNo, "Are you sure?")

If answer = vbNo Then    'This will test if user said "No" and will protect the sheets
    For a = Worksheets.Count To ActiveSheet.Index Step -1
    Sheets(a).Protect "arafluid"
    Next a
    Exit Sub
End If

作为一个注释，在第一个MsgBox之后，对于相同的事情你有两个If语句具有相同的情况，你可以将它们简化为：

            If answer = vbNo Then 
                ActiveSheet.Protect "arafluid"
                Exit Sub
            End If

VBA代码保护所有工作表，具体取决于响应

1 个答案: