希望有人能用我当前的代码指出我的问题,因为我的代码无法检测到彩色格式的单元格,并删除了其他没有彩色格式单元格的列。
我创建的是合并工作表中的数据透视表(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”等等)。这就是我将数据透视表作为副本复制到另一个工作表的原因,以便根据列和行缩小我的颜色格式化单元格,以便更好地进行演示。
感谢您的时间和理解。提前谢谢!