循环播放工作表以删除某些单元格

时间:2015-08-17 18:44:55

标签: excel-vba vba excel

我希望从工作簿中的工作表中删除特定单元格。在这样做时,它还应删除工作簿的这些工作表中具有公式错误的特定单元格。 我在@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

运行代码后,它会删除输入框中的单元格输入,即它会清空单元格中的数据,并将剩余的数据附加到最后一个填充行末尾的行中。它不会消除错误单元格,程序会给出错误消息:  方法&#39; object_Global联合失败

在以下代码行

&#39;设置delRange = Union(delRange,.Columns(i))&#39;

proram run之后的示例数据附加在下面。

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

sheet2 after program run no action on error cell

请帮助您找到程序中的错误。所需结果是输入单元格范围应该消隐,保留其行位置。对于错误单元也是如此。

由于

3 个答案:

答案 0 :(得分:2)

@IBAction func buttonAction(sender: UIButton)
{
  //In this case the button IBAction takes a pointer to the button as a param.
  //Pass it on to the segue in case performWithSegue needs it. 
  self.performSegueWithIdentifier("someID", sender: sender)
}

答案 1 :(得分:1)

没有太多解决方案,但错误的原因是Union不能跨工作表工作。它适用于单张纸上的范围。

您可以调整代码以一次处理一张表格:

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

答案 2 :(得分:0)

您可以使用IsNumeric检查单元格是否包含数值。错误不是数值,因此IsNumeric(Cell with error)= 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。简单地跳过这些分歧。