Удалить ячейки в настраиваемых группах вместо целых строк или столбцов

Question

У меня есть этот код, который удаляет ячейки по всему столбцу. Первоначально я думал, что это будет полезно, позже я понял, что если я это сделаю, полезные данные в том же столбце тоже будут удалены. Поэтому мне нужен код, который позволяет мне удалить любой диапазон ячеек будь то строки или столбцы в моем собственном удобстве

Sub TestDatabase() 

Dim rng As range, rngError As range, delRange As range 
Dim i As Long, j As Long, k As Long 
Dim wks As Worksheet 

On Error Resume Next 

Set rng = Application.InputBox("Select cells To be deleted", Type:=8) 

On Error GoTo 0 

If rng Is Nothing Then Exit Sub Else rng.delete 

For k = 1 To ThisWorkbook.Worksheets.Count 'runs through all worksheets 

    Set wks = ThisWorkbook.Worksheets(k) 

    With wks 

    For i = 1 To 7 '<~~ Loop trough columns A to G 

     '~~> Check if that column has any errors 
     On Error Resume Next 

     Set rngError = .Columns(i).SpecialCells(xlCellTypeFormulas, xlErrors) 

     On Error GoTo 0 

     If Not rngError Is Nothing Then 
      For j = 1 To 100 '<~~ Loop Through rows 1 to 100 
       If .Cells(j, i).Text = "#REF!" Then 
        '~~> Store The range to be deleted 
        If delRange Is Nothing Then 
         Set delRange = .Columns(i) 
         Exit For 
        Else 
         Set delRange = Union(delRange, .Columns(i)) 
        End If 
       End If 
      Next j 
     End If 

    Next i 

    End With 

Next k 

'~~> Delete the range in one go 
If Not delRange Is Nothing Then delRange.delete 

End Sub 

Answer 1

Я думаю, что для того, чтобы достичь ваших потребностей, вам нужно просто удалить метод .Columns(). Это, в свою очередь, вызывает новую проблему - когда вы удаляете ячейку, каким образом Excel должен переместить остальные ячейки?

Вы могли бы попробовать что-то вроде этого:

If .Cells(j, i).Text = "#REF!" Then 
    '~~> Store The range to be deleted 
    If delRange Is Nothing Then 
     Set delRange = .Cells(j, i) 
     '// Exit For <~~ This stops your code adding any more cells to delRange 
    Else 
     Set delRange = Union(delRange, .Cells(j, i)) 
    End If 
End If 

, а затем при удалении:

'// Could use xlUp, xlDown, xlToRight or xlToLeft 
delRange.delete shift:=xlUp 

Стоит отметить, что, поскольку delRange теперь указывает на группу ячеек, вы можете удалить:

• Клетки только, используя метод выше.
• Строки, принадлежащие к этим клеткам с помощью delRange.EntireRow.Delete shift:=xlUp
• или столбцов, принадлежащих к этим клеткам, используя delRange.EntireColumn.Delete shift:=xlToLeft

Answer 2

Хотя я до сих пор неясно, о своей конечной цели, удаляя любой размер или диапазон формы довольно прост , Как при очистке (или удалении) всех ваших ошибок #REF!.

Я предлагаю вам подобрать Peter Thornton's GetInputRange function, который может решить любые потенциальные проблемы, которые могут возникнуть у вас, используя InputBox, чтобы получить диапазон от вашего пользователя.

Option Explicit 

Sub Test() 
    Dim targetArea As Range 
    Dim success As Boolean 

    '--- clears only the contents from the currently selected area 
    Set targetArea = Application.Selection 
    targetArea.ClearContents 
    '--- optionally delete the area, but this shifts all the other data into the area 
    'targetArea.Delete Shift:=xlShiftUp 
    ClearAllRefErrors 

    '--- asks for the area to be cleared 
    ' uses Peter Thornton's GetInputRange method (http://www.jkp-ads.com/Articles/SelectARange.asp) 
    success = GetInputRange(targetArea, "Enter the range to delete:", "Delete Range", _ 
          Application.Selection.Address) 
    If success Then 
     targetArea.ClearContents 
     '--- optionally delete the area, but this shifts all the other data into the area 
     'targetArea.Delete Shift:=xlShiftUp 
     ClearAllRefErrors 
    End If 
End Sub 

Sub ClearAllRefErrors() 
    Dim ws As Worksheet 
    Dim rangeInUse As Range 
    Dim rangeCell As Range 

    For Each ws In ThisWorkbook.Sheets 
     Set rangeInUse = Application.ActiveSheet.usedRange 
     For Each rangeCell In rangeInUse 
      If rangeCell = CVErr(xlErrRef) Then 
       rangeCell.ClearContents 
       '--- optionally delete the cell, but this shifts all the other data 
       'rangeCell.Delete Shift:=xlShiftUp 
      End If 
     Next rangeCell 
    Next ws 
End Sub