除40,6

时间:2019-12-03 20:48:05

标签: excel vba

我有一个宏,可以根据我选择的单元格颜色删除内容,它仅适用于表格和标题中设置的颜色。我尝试了几种颜色,但只有索引颜色40和6有效。错误为“运行时错误'91'对象变量或未设置带块变量”。

谁能告诉我有什么区别?预先谢谢你。

Option Explicit
Sub Column_Clear()
Dim LastRow As Long
Dim LastColumn As Long
Dim ws As Worksheet
Dim oList As ListObject
Dim ColorFound As Variant
Dim CopyAndPasteColumnColor As Variant
Dim StartCopyAndPasteCell As String
Dim cell As Range

''' Adjusting if needed
CopyAndPasteColumnColor = 50
Application.FindFormat.Clear 'Ensure Find Formatting Rule is Reset
For Each ws In Worksheets
ws.Activate ' Go to this sheet
For Each oList In ws.ListObjects
    For Each cell In oList.HeaderRowRange ' Searching cells within first row
        Set oList = ws.ListObjects(oList.Name)
        oList.AutoFilter.ShowAllData ' Take out filter
        Application.FindFormat.Interior.colorIndex = CopyAndPasteColumnColor ' Store active cell's fill color into "Find"

        If cell.Interior.colorIndex = CopyAndPasteColumnColor Then
            ColorFound = oList.HeaderRowRange.Find("", , , , , , , , True).Address(False, False) ' Find the address based on the cell color as you want
            StartCopyAndPasteCell = ws.Range("" & ColorFound & "").Offset(1, 0).Address
            LastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row
            LastColumn = ws.Range("" & ColorFound & "").Column
            ws.Range(StartCopyAndPasteCell & ":" & Col_Letter(LastColumn) & LastRow).ClearContents ' Clear contents based on the color
            ws.Range(StartCopyAndPasteCell & ":" & Col_Letter(LastColumn) & LastRow).Select

            Debug.Print "Table name:                " & oList.Name
            Debug.Print "Color Found:               " & ColorFound
            Debug.Print "Start Copy and Paste Cell: " & StartCopyAndPasteCell
            Debug.Print "End Copy and Paste Cell:   " & Col_Letter(LastColumn) & LastRow
            Debug.Print vbNewLine
            Application.FindFormat.Clear 'Ensure Find Formatting Rule is Reset
        Else
               'Nothing
        End If
    Next cell
Next oList
Next ws
End Sub


Public Function Col_Letter(lngCol As Long) As String
    Dim vArr
    vArr = Split(Cells(1, lngCol).Address(True, False), "$")
    Col_Letter = vArr(0)
End Function

0 个答案:

没有答案