删除单元格内容并向上移动而不排序答案

【问题标题】：Remove Cell Content & Shift Up Without Sort删除单元格内容并向上移动而不排序
【发布时间】：2013-02-18 16:52:18
【问题描述】：

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

此站点上的@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 没有错，更多的是我的要求发生了变化。

为了指导用户需要在哪一行添加新记录，我设置了一个文本信号，即“输入您的姓名”，它始终出现在第一个空行上，为用户添加新记录做好准备。不幸的是，这个值也被排序了，这就是我的问题所在。

我已经尝试了几天来提出一个解决方案，从上面的代码中删除“排序”功能，而其余功能保持不变。可惜没有成功。

有人可以请看一下这个，并就如何删除单元格的排序提供一些指导。

非常感谢和亲切的问候

【问题讨论】：

如何不使用文本“在此处输入您的姓名”，而是使用单元格格式...如红色突出显示的单元格。一旦单元格包含一些文本，您就可以取消突出显示。您还可以自动化条件格式来获取您想要显示的文本，而单元格中实际上没有文本。
嗨@ScottHoltzman，感谢您抽出宝贵时间回复我的帖子。我曾想过这种做事方式。不过，目前我想看看我是否可以让这个工作。亲切的问候。克里斯
在这种情况下，在“在此处输入您的姓名”单元格前 1 个单元格结束您的排序范围
@IRHM 当你说“它总是出现在第一个空行上，准备好让用户添加新记录”时，你的意思是有很多行被保留用于指定一个部分为不同员工保留的工作表（即每个员工在工作簿中都有自己的特定部分）？或者您的意思是工作表中的第一个空行在每一列中都有一个员工姓名或类似的东西？
嗨@Lopside，感谢您抽出宝贵时间回复我的帖子，对于没有尽快回复我深表歉意。在过去的几天里，我一直在研究这个问题，并制定了一个可行的解决方案，您将在下面的帖子中看到。再次非常感谢和亲切的问候。克里斯

标签： excel excel-2003 vba

【解决方案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

【讨论】：