除了数据透视表中存在的彩色格式化单元格之外,如何删除其他列?

时间:2016-10-03 06:28:38

标签: excel vba excel-vba

希望有人能用我当前的代码指出我的问题,因为我的代码无法检测到彩色格式的单元格,并删除了其他没有彩色格式单元格的列。

我创建的是合并工作表中的数据透视表(PT1),我还应用了某些条件格式。条件格式化后,某些单元格具有红色背景颜色。我现在想要实现的是将整张PT1复制到同一工作簿中的另一个工作表,并删除没有彩色格式单元格的列。

Sub Filter()

Dim sh As Worksheet
Dim DestSh As Worksheet
Dim opensheet As Worksheet
Dim Filterlastcol As Integer, Filterlastrow As Integer
Dim Pivotprefix As String
Dim FilterPivRng As Range, c As Range
Dim i As Long, j As Long, targetfilter As Long

  With Application
  .ScreenUpdating = False
  .EnableEvents = False
  End With

'Delete the filter pivot table if it exists
  Application.DisplayAlerts = False
  On Error Resume Next
  For Each opensheet In Application.Worksheets

  Pivotprefix = Left(opensheet.Name, 4)

  If Pivotprefix = "Filt" Then
      opensheet.Delete
  End If

Next opensheet

'select and copy entire sheet that has pivot table and paste to new sheet     
  Sheets("Pivot_Table (Name)").Select
  Cells.Select
  Selection.Copy
  Set DestSh = ActiveWorkbook.Worksheets.Add
  DestSh.Name = "Filter Pivot Table"
  Range("A1").Select
  ActiveSheet.Paste
  Application.CutCopyMode = False

'Determine my entire range of pivot table (does not include row header
 or column header)

    Range("B5").Select

    Do Until IsEmpty(ActiveCell)

        Filterlastcol = ActiveCell.Column

        ActiveCell.Offset(0, 1).Select
    Loop

    Range("B5").Select

    Do Until IsEmpty(ActiveCell)

        Filterlastrow = ActiveCell.Row

        ActiveCell.Offset(1, 0).Select
    Loop

    'set my range without the last row (grandtotal), hence row = filterlastrow -1

     Set FilterPivRng = Range(Cells(5, 2), Cells(Filterlastrow - 1, Filterlastcol))

        For i = 1 To FilterPivRng.Rows.Count
            For j = 1 To FilterPivRng.Columns.Count

                targetfilter = FilterPivRng.Cells(i, j).Interior.Color

           If targetfilter <> rgbRed Then
            Cells(i, j).EntireColumn.Delete
            End If

        Next j
    Next i

  End Sub

我在代码的最后部分做错了吗?我对颜色格式化细胞不是很熟悉。令人惊讶的是,代码可以运行,但最终似乎没有发生。当我单击F8查看故障时,前面的一切都很好,直到它到达删除列部分。

*编辑

*我正在进行数据透视表删除列以缩小范围的主要原因是,我的日期字段无法过滤,因为它显示为列。日期不会出现在一列中,它是特定日期范围内同一行的一系列列(“Sum 1/9/16”,“Sum 2/9/16”等等)。这就是我将数据透视表作为副本复制到另一个工作表的原因,以便根据列和行缩小我的颜色格式化单元格,以便更好地进行演示。

感谢您的时间和理解。提前谢谢!

0 个答案:

没有答案