删除行和维护输入范围

Question

我想知道是否有人能够帮助我请。

这几周我一直在试图找到一个解决方案，使用户可以执行以下操作：使用和不使用数据

• 删除行，
• 移的所有行包含数据的麻生太郎，他们坐一个在另一个
• ，同时保持一个定义的“输入范围”

我已经把下面的脚本，它会清除单元格的内容，因此不会改变“输入范围” 。

Sub DelRow() 

     Dim msg 

      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 
       Selection.SpecialCells(xlCellTypeConstants).ClearContents 
       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 

更新的代码

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 
    Else 
    Selection.Sort Key1:=Range("B7"), Order1:=xlAscending, Header:=xlNo, _ 
     OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ 
     DataOption1:=xlSortNormal 
    End If 
    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 

与此虽然该问题是，如果用户选择一个空白行他们收到“错误400”消息，并且它不行上移坐在对方下面。

正如我所说，我花了这么多时间试图找到一个没有任何成功的解决方案。

我真的很感激，如果有人可以看看这个请给我提供一些指导我可以做到这一点。

许多的感谢和亲切的问候

Answer 1

如果选择为空，行Selection.SpecialCells(xlCellTypeConstants).ClearContents 将失败，因为没有xlCellTypeConstants。你需要测试这一点，只要有任何明确的内容：

编辑：为了回答排序问题

我觉得你只是想不管什么样的，所以我就搬到了Sort后ClearContents。我将UsedRange排序，但我不认为是你想要的。您需要定义要排序的范围，可以使用Excel中的名称管理器或代码中的命名范围。

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 
    'You need to define a range that you want sorted 
    'here I've used UsedRange 
    ActiveSheet.UsedRange.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