1

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

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

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

几天来，我一直在尝试提出一个解决方案，从上面的代码中删除“排序”功能，而其余功能保持不变。不幸的是没有任何成功。

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

非常感谢和亲切的问候

4

1 回答 1

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
于 2013-02-21T16:43:10.187 回答