删除单元格内容并删除上移而不排序 [英] Remove Cell Content & Shift Up Without Sort

问题描述

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

I wonder whether someone may be able to help me please.

@Doug Clancy在此站点上提供了一些非常值得赞赏的指导和解决方案(如下所示)，该指南和解决方案清除了单元格内容，并在必要时将行向上移动以填充空白行.

@Doug Clancy on this site offered some very much appreciated guidance and solution (shown below), which clears cell content and where necessary shifts the rows up to fill those that are blank.

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没错，我的要求有了更多变化.

The code correctly works, but I have a slight problem, through no fault of @Doug Clancy, more a change in my requirements.

为指导用户他们需要向其添加新记录的行，我设置了文本信号，即输入您的姓名"，该信号始终出现在第一行空白处，以供用户添加新记录.不幸的是，这个值也是从排序中获得的，这就是我的问题所在.

To guide users on which row they need to add new records to, I've set a text signal i.e. "Enter your name", which always appears on the first empty row, ready for the user to add a new record. Unfortunately, this value is also picked up on the sort, which is where my problem lies.

我已经尝试了几天，想出一种解决方案，从上面的代码中删除"Sort"功能，而其余功能保持不变.不幸的是没有成功.

I've been trying for a few days now to come up with a solution whereby the 'Sort' function is removed from the above code, with the remaining functionality left intact. Unfortunately without any success.

请让我看看，并提供一些有关如何删除单元格排序的指导.

Could someone please, please have a look at this and offer some guidance on how I can remove the sorting of the cells.

非常感谢和问候

推荐答案

在过去几天中进行了此工作之后，我提出了以下解决方案:

After working on this over the last few days, I've put together the following solution:

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

这篇关于删除单元格内容并删除上移而不排序的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！