Question

我的问题：

我想循环遍历一个范围，每当它找到一个有色单元格时，它应该将单元格复制到左边的单元格到右边的单元格。然后将其粘贴到另一个工作表中。

我的工作表名为“Compare”比较两组数据，而FormatConditions则应用为xlUniqueValues ...这两组数据应该包含相同的数据，但有时会有一些，不在其他范围。我喜欢用循环查找这些单元格，然后在符合条件的情况下使用这些单元格。

我的代码没有遍历单元格并返回此消息：

运行时错误'438'：对象不支持此属性或方法

Sheet“Compare”中的部分数据的屏幕截图：

我的代码：

    Sub LoopForCondFormatCells()

    Dim sht3, sht4 As Worksheet
    Dim ColB, c As Range
    Set sht3 = Sheets("Compare")
    Set sht4 = Sheets("Print ready")

    ColB1 = sht3.Range("G3:G86")
    Set ColB = Range(ColB1)

   For Each c In ColB.Cells
   If c.FormatConditions.Type = xlUniqueValues Then 'Error here!
        CValue = c.Address(False, False, xlA1)
        CValueOffsetL = sht3.Range(CValue).Offset(0, -1).Address(False, False, xlA1)
        CValueOffsetR = sht3.Range(CValue).Offset(0, 1).Address(False, False, xlA1)
        sht3.Range(CValueOffsetL, CValueOffsetR).Copy
        KvikOffIns = sht4.Range(HosKvikOff).Offset(0, -1).Address(False, False, xlA1)
        sht4.Range(KvikOffIns).PasteSpecial xlPasteAll
        End If
    Next c

目标：

我希望宏遍历单元格，并找到任何具有FormatConditions类型“xlUniqueValues”的单元格。每当遇到一个单元格，即FormatConditions类型“xlUniqueValues”时，它应该执行以下步骤：

CValue = c.Address(False, False, xlA1)
CValueOffsetL = sht3.Range(CValue).Offset(0, -1).Address(False, False, xlA1)
CValueOffsetR = sht3.Range(CValue).Offset(0, 1).Address(False, False, xlA1)
sht3.Range(CValueOffsetL, CValueOffsetR).Copy
KvikOffIns = sht4.Range(HosKvikOff).Offset(0, -1).Address(False, False, xlA1)
sht4.Range(KvikOffIns).PasteSpecial xlPasteAll

我应该在我的“If c Is”行中写什么来让宏做我想做的事情？

Answer 1

您的代码中存在许多问题

声明所有变量。（在模块顶部包含Option Explicit以强制执行此操作
具体说明所有声明（Dim sht3, sht4 As Worksheet声明sht3为Variant）
您的引用范围的方法是错综复杂的，令人困惑且不必要的
c.FormatConditions是条件格式的集合，并且没有Type。迭代集合并测试每个
您正在复制所有内容，包括条件格式。这是你的意图吗？如果没有，我会更新答案以显示不同的方式

重构的代码

Option Explicit

Sub LoopForCondFormatCells()

    Dim sht3 As Worksheet, sht4 As Worksheet
    Dim ColB As Range, c As Range
    Dim ColB1 As Range

    Dim HosKvikOff As Range
    Dim n As Long

    Set sht3 = Worksheets("Compare")
    Set sht4 = Worksheets("Print ready")

    Set HosKvikOff = sht4.Range("A1")  ' <-- update to suit

    Set ColB1 = sht3.Range("G3:G86")

    For Each c In ColB1.Cells
        With c.FormatConditions
            For n = 1 To .Count
                If .Item(n).Type = xlUniqueValues Then
                    c.Offset(0, -1).Resize(1, 3).Copy
                    HosKvikOff.PasteSpecial xlPasteAll
                    Set HosKvikOff = HosKvikOff.Offset(1, 0)  ' Increment output row
                End If
            Next

        End With
    Next
End Sub

不依赖于条件格式的方法

Option Explicit

Sub LoopForCondFormatCells()
    Dim sht3 As Worksheet, sht4 As Worksheet
    Dim ColB As Range, c As Range
    Dim ColB1 As Range

    Dim HosKvikOff As Range
    Dim n As Long

    Set sht3 = Worksheets("Compare")
    Set sht4 = Worksheets("Print ready")

    Set HosKvikOff = sht4.Range("A1")

    Set ColB1 = sht3.Range("G3:G86")

    ' Copy Non-duplicates
    For Each c In ColB1.Cells
        If Not IsEmpty(c) Then
            n = Application.WorksheetFunction.CountIfs(ColB1, c)
            If n = 1 Then
                c.Offset(0, -1).Resize(1, 3).Copy
                HosKvikOff.PasteSpecial xlPasteAll
                Set HosKvikOff = HosKvikOff.Offset(1, 0)
            End If
        End If
    Next

End Sub

Excel VBA遍历范围以查找FormatCondition的类型

1 个答案: