刪除行和維護輸入範圍

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