Question

我想知道是否有人可以帮助我。

@Doug Clancy在这个网站上提供了一些非常受欢迎的指导和解决方案（如下所示），它清除了单元格内容，并在必要时将行向上移动以填充那些空白。

Sub DelRow()
Dim RangeToClear As Range
Dim msg As VbMsgBoxResult

Sheets("Input").Protect "handsoff", UserInterfaceOnly:=True
Application.EnableCancelKey = xlDisabled
Application.EnableEvents = False
msg = MsgBox("Are you sure you want to delete this row?", vbYesNo)
If msg = vbNo Then Exit Sub
With Selection
    Application.Intersect(.Parent.Range("A:S"), .EntireRow).Interior.ColorIndex = xlNone
    Application.Intersect(.Parent.Range("T:AE"), .EntireRow).Interior.ColorIndex = 42
    On Error Resume Next
    Set RangeToClear = Selection.SpecialCells(xlCellTypeConstants)
    On Error GoTo 0    ' or previously defined error handler
    If Not RangeToClear Is Nothing Then
        RangeToClear.ClearContents
    End If
    ActiveSheet.Range("A7:AG400").Sort Key1:=Range("B7"), _
    Order1:=xlAscending, Header:=xlNo, _
    OrderCustom:=1, MatchCase:=False, _
    Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal

    Application.Intersect(.Parent.Range("C:AE"), .EntireRow).Locked = True
    Application.Intersect(.Parent.Range("AG:AG"), .EntireRow).Locked = True
End With
Application.EnableEvents = True
End Sub

代码正常工作，但我有一个小问题，因为没有@Doug Clancy的错误，更多的是我的要求的变化。

为了引导用户在哪些行上添加新记录，我设置了一个文本信号，即“输入你的名字”，它总是出现在第一个空行上，为用户添加新记录做好准备。不幸的是，这个值也会在排序上被选中，这就是我的问题所在。

我已经尝试了几天来提出一个解决方案，从上面的代码中删除'Sort'功能，剩下的功能保持不变。不幸的是没有任何成功。

有人可以，请看一下这个，并就如何删除细胞分类提供一些指导。

非常感谢和亲切的问候

Answer 1

在过去几天完成这项工作之后，我将以下解决方案放在一起：

Sub DelRow()

Dim DoesItExist As Range
Dim msg As VbMsgBoxResult
Dim RangeToClear As Range

Sheets("Input").Protect "handsoff", UserInterfaceOnly:=True
Application.EnableCancelKey = xlDisabled
Application.EnableEvents = False
msg = MsgBox("Are you sure you want to delete this row?", vbYesNo)
If msg = vbNo Then Exit Sub
With Range("B7", Range("B" & Rows.Count).End(xlUp))
    .Value = Evaluate("if(" & .Address & "<>"""",if(isnumber(search(""Enter your name""," & _
        .Address & ")),""""," & .Address & "),"""")")
End With
With Selection
    Application.Intersect(.Parent.Range("A:S"), .EntireRow).Interior.ColorIndex = xlNone
    Application.Intersect(.Parent.Range("T:AE"), .EntireRow).Interior.ColorIndex = 42
    On Error Resume Next
    Set RangeToClear = Selection.SpecialCells(xlCellTypeConstants)
    On Error GoTo 0    ' or previously defined error handler
    If Not RangeToClear Is Nothing Then
        RangeToClear.ClearContents
    End If

    ActiveSheet.Range("A7:AG400").Sort Key1:=Range("B7"), _
    Order1:=xlAscending, Header:=xlNo, _
    OrderCustom:=1, MatchCase:=False, _
    Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal

    Application.Intersect(.Parent.Range("C:AE"), .EntireRow).Locked = True
    Application.Intersect(.Parent.Range("AG:AG"), .EntireRow).Locked = True
End With
    Set DoesItExist = Sheets("Input").Range("B7:B10").Find("Enter your name")
       If Not DoesItExist Is Nothing Then Exit Sub
       Sheets("Input").Select
       Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = "Enter your name"
       Columns("B:B").Locked = False  ' to unlock the whole column
       Columns("B:B").SpecialCells(xlCellTypeBlanks).Locked = True
Application.EnableEvents = True
End Sub

删除细胞内容＆amp;没有排序的向上移动

1 个答案: