2015-08-17 84 views
2

我希望從工作簿中的表單中刪除特定的單元格。雖然這樣做也應該刪除工作簿的這些工作表中的具有公式錯誤的特定單元格。 我在@Blind Seer中使用了一個最近的程序在stackoverflow中,下面的鏈接是用於類似的應用程序。循環遍歷表以刪除特定的單元格

incorporating-sheet-loop

程序運行之前的工作簿片的樣品被附加以下

data sample sheet1 before program run

data sample sheet2before program run

代碼由我採用如下。

Sub DeleteCells() 

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 = "#DIV/0!" 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 

運行它刪除單元格中輸入在輸入框中即它從空白單元格中的數據,並在最後填充行的末尾添加數據的其他行中的代碼後。它不是消隱出錯誤細胞和程序提供錯誤消息: 方法組delRange =聯盟(delRange,.Columns(i))的「object_Global聯盟上下面的代碼線

失敗

‘’

proram運行後的樣本數據如下所示。

sheet1 after program run row 100 has partial data blanking out cell A1

sheet2 after program run no action on error cell

請在程序定位錯誤的幫助。所需的結果是輸入單元格範圍應該保留其行位置。對於錯誤單元格也一樣。

謝謝

+0

如果你的細胞在其他細胞的細胞商,可以考慮使用這種替代代碼; https://support.microsoft.com/en-us/kb/182188。單元格的文本/值不是#DIV/0。你可以通過msgbox Range(錯誤單元格地址)來測試。價值,你會看到它不會返回DIV/0 –

+0

聯盟不能在多個工作表上運行 - 希望我的答案仍然可以按照您的預期運行:可以一次運行代碼嗎? – whytheq

回答

2
Option Explicit 

Sub DeleteCells() 
    Dim ws As Worksheet, rng As Range, rngErr As Range 

    On Error Resume Next 

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

    If Not rng Is Nothing Then 
     rng.Delete 
     For Each ws In ThisWorkbook.Worksheets 
      Set rngErr = ws.UsedRange.SpecialCells(xlCellTypeFormulas, xlErrors) 
      If Not rngErr Is Nothing Then rngErr.Clear 
     Next 
    End If 
End Sub 
0

您可以使用IsNumeric檢查單元是否包含數值。錯誤不是數字值,所以IsNumeric(錯誤的單元格)= False。我修改您的代碼:

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 Not IsNumeric(.Cells(j, i)) 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 

注:這意味着,如果有時文本將被輸入,它會指望它作爲一個錯誤。所以要小心,如果是這樣的話!

此外,根據我的評論;如果您的單元格是其他單元格上的單元格的商,請考慮使用此代替代碼; support.microsoft.com/en-us/kb/182188。簡單地跳過部門。

+0

@paul bica建議的程序工作順利。非常感謝。 – skkakkar

+0

@whytheq感謝您的幫助。我仍在制定計劃,稍後恢復。 – skkakkar

+0

感謝您的幫助。我仍在制定計劃,稍後恢復。 – skkakkar

1

沒有太多的解決方案,但錯誤的原因是聯盟不跨越工作表。它將適用於單張紙上的範圍。

你可以調整你的代碼在上班時間一個表:

Sub DeleteCells() 

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 
    With ThisWorkbook.Worksheets(k) '<<do each sheet individually so that Union functions as expected 

    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 = "#DIV/0!" 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 
相關問題