Question

这可能与this question类似，但我相信它在复杂性方面更进一步，这就是我提出这个问题的原因。

上下文：我正在建立一个可以在表格中创建和删除行的预算电子表格。在表格中我有两张桌子。一个包含基于类别的总计，而另一个表包含用户可以输入的事务以填充另一个表中的总计。我保护工作表，以防止用户违反公式，只让他们应编辑的单元格（即输入值）不受保护。我还有一些宏来插入和删除一个表上的一行或多行（我编写宏以在宏运行完成之前和之后取消保护/保护工作表。）

问题：我的问题涉及first table。在那张表中，我想确保＆＃34;存款＆＃34;行无法删除。问题是，在我的代码中，我如何确保用户可以删除包含＆＃34;存款＆＃34;的另一个表中的所有其他行。同时防止删除＆＃34;存款＆＃34;在这张表中排？我正在考虑以下伪代码，但随意提出其他建议：

'If selected range contains cells in Column A
'and cell in selected range = Deposits
'Then pop error message
'Exit Sub

这是我删除宏的代码

Sub DeleteRow()
'
' DeleteRow Macro
'
' Keyboard Shortcut: Ctrl+Shift+D
'

Dim loTtest         As ListObject
Dim loSet           As ListObject
Dim c               As Range
Dim arrRows()       As Variant
Dim arrTemp()       As Variant
Dim xFind           As Variant
Dim iCnt            As Long
Dim sMsg            As String

ActiveSheet.Unprotect Password:="PYS"
Erase arrRows()
iCnt = 1
For Each c In Selection.Cells
    If Not c.ListObject Is Nothing Then
        If loSet Is Nothing Then
            Set loSet = c.ListObject
        Else
            If c.ListObject <> loSet Then
                'different table
                MsgBox "You have more than one table selected.", vbInformation, "ERROR!"
                ActiveSheet.Protect Password:="PYS"
                GoTo MyExit
            End If
        End If

        If iCnt = 1 Then
            ReDim arrRows(1 To iCnt)
            arrRows(iCnt) = c.Row - loSet.HeaderRowRange.Row
            iCnt = iCnt + 1
        Else
            On Error Resume Next
            xFind = 0
            xFind = WorksheetFunction.Match(c.Row - loSet.HeaderRowRange.Row, arrRows(), 0)
            If xFind = 0 Then
                ReDim Preserve arrRows(1 To iCnt)
                arrRows(iCnt) = c.Row - loSet.HeaderRowRange.Row
                iCnt = iCnt + 1
            End If
            Err.Clear
            On Error GoTo 0
        End If

    Else
        'a cell is not in a table
        MsgBox "Your selection is all or partially outside of a table.", vbInformation, "ERROR!"
        ActiveSheet.Protect Password:="PYS"
        GoTo MyExit
    End If
Next c

Call SortArray(arrRows())
sMsg = "Are you sure you want to delete " & UBound(arrRows) & " rows from from this table?"
If MsgBox(sMsg, vbYesNo + vbDefaultButton2, "CONTINUE?") <> vbYes Then
    ActiveSheet.Protect Password:="PYS"
    Exit Sub
End If

For iCnt = UBound(arrRows) To LBound(arrRows) Step -1

    loSet.ListRows(arrRows(iCnt)).Delete
Next iCnt
ActiveSheet.Protect Password:="PYS"
Exit Sub

MyExit:

End Sub



Sub SortArray(MyArray() As Variant)

Dim iStart          As Long
Dim iEnd            As Long
Dim iStep           As Long
Dim iMove           As Long
Dim vTemp           As Variant

iStart = LBound(MyArray)
iEnd = UBound(MyArray)
For iStep = iStart To iEnd - 1
    For iMove = iStep + 1 To iEnd
        If MyArray(iStep) > MyArray(iMove) Then
            vTemp = MyArray(iMove)
            MyArray(iMove) = MyArray(iStep)
            MyArray(iStep) = vTemp
        End If
    Next iMove
Next iStep

End Sub

顺便说一下，我自己并没有想出这一切;我把这段代码中的大部分都丢了。 :)如果您需要更多信息或上下文，请告诉我。提前谢谢！

Here is the link to the budget workbook.

Answer 1

如果ActiveSheet.Cells（c.Row，1）.Value =＆＃34;存款＆＃34;那么这是工作的DeleteRow子

Sub DeleteRow()
'
' DeleteRow Macro
'
' Keyboard Shortcut: Ctrl+Shift+D
'

    Dim loTtest         As ListObject
    Dim loSet           As ListObject
    Dim c               As Range
    Dim arrRows()       As Variant
    Dim arrTemp()       As Variant
    Dim xFind           As Variant
    Dim iCnt            As Long
    Dim sMsg            As String

    ActiveSheet.Unprotect Password:="PYS"
    Erase arrRows()
    iCnt = 1

    'This is the loop that I added before anything else to keep people from deleting the row with "Deposits"
    For Each c In Selection.Cells
        If ActiveSheet.Cells(c.Row, 1).Value = "Deposits" Then
            MsgBox "Your Selection contains 'Deposits'!" & vbCrLf & _
                "The 'Deposits' row cannot be deleted!", vbExclamation
            GoTo MyExit
        End If
    Next

    For Each c In Selection.Cells
        If Not c.ListObject Is Nothing Then
            If loSet Is Nothing Then
                Set loSet = c.ListObject
            Else
                If c.ListObject <> loSet Then
                    'different table
                    MsgBox "You have more than one table selected.", vbInformation, "ERROR!"
                    ActiveSheet.Protect Password:="PYS"
                    GoTo MyExit
                End If
            End If

            If iCnt = 1 Then
                ReDim arrRows(1 To iCnt)
                arrRows(iCnt) = c.Row - loSet.HeaderRowRange.Row
                iCnt = iCnt + 1
            Else
                On Error Resume Next
                xFind = 0
                xFind = WorksheetFunction.Match(c.Row - loSet.HeaderRowRange.Row, arrRows(), 0)
                If xFind = 0 Then
                    ReDim Preserve arrRows(1 To iCnt)
                    arrRows(iCnt) = c.Row - loSet.HeaderRowRange.Row
                    iCnt = iCnt + 1
                End If
                Err.Clear
                On Error GoTo 0
            End If

        Else
            'a cell is not in a table
            MsgBox "Your selection is all or partially outside of a table.", vbInformation, "ERROR!"
            ActiveSheet.Protect Password:="PYS"
            GoTo MyExit
        End If
    Next c

    Call SortArray(arrRows())
    sMsg = "Are you sure you want to delete " & UBound(arrRows) & " rows from from this table?"
    If MsgBox(sMsg, vbYesNo + vbDefaultButton2, "CONTINUE?") <> vbYes Then
        ActiveSheet.Protect Password:="PYS"
        Exit Sub
    End If

    For iCnt = UBound(arrRows) To LBound(arrRows) Step -1
        loSet.ListRows(arrRows(iCnt)).Delete
    Next iCnt
    ActiveSheet.Protect Password:="PYS"
    Exit Sub

MyExit:

End Sub

阻止用户在Excel中的特定列中删除特定表中具有特定值的行

1 个答案: