Excel VBA 遍历 2 列，只复制符合条件的一个范围内的单元格

Question

我的问题：

我想遍历一个范围，每当它找到一个彩色单元格时，它应该将左侧的单元格复制到它右侧的单元格。然后粘贴到其他作品sheet.

我的sheet叫“Compare”比较两组数据，而一个FormatConditions应用为xlUniqueValues...这两组数据，应该包含相同的数据，但有时，会有一些, 不在其他范围内。我感兴趣的是通过循环查找这些单元格，然后在满足条件的情况下进行处理。

我的代码没有遍历单元格，return向我发送了这条消息：

Run-time error '1004": Method 'CountIfs' of object 'WorksheetFunction' failed

Sheet中部分数据截图 "Compare":

我的代码：

    Sub LoopForCondFormatCells()

    Dim sht3, sht4 As Worksheet
    Dim ColB, ColG, ColBG c As Range
    Set sht3 = Sheets("Compare")
    Set sht4 = Sheets("Print ready")
    Set ColG = sht3.Range("B3:B88")
    Set ColB = sht3.Range("G3:G86")


    HosKvik = sht4.Columns("B").Find("Hos Kvik, men ikke bogføring", Lookat:=xlWhole).Address(False, False, xlA1)
    HosKvikOff = sht4.Range(HosKvik).Offset(1, 0).Address(False, False, xlA1)
    Set HosKvikOffIns = sht4.Range(HosKvikOff).Offset(1, -1)    
    ColBG1 = ColB & "," ColG
    Set ColBG = Range(ColBG1)
'In the following For Each strings, I would like it to look in the range ColBG, _
but it should only return the value it finds in ColB... _
But I don't know how to write the code to do so
For Each c In ColB.Cells
    If Not IsEmpty(c) Then
        n = Application.WorksheetFunction.CountIfs(ColBG, c) 'Error here
        If n = 1 Then
            c.Offset(0, -1).Resize(1, 3).Copy
            HosKvikOffIns.PasteSpecial xlPasteAll
            Set HosKvikOffIns = HosKvikOffIns.Offset(1, 0)
        End If
    End If
Next

目标：

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

For Each c In ColB.Cells
    If Not IsEmpty(c) Then
        n = Application.WorksheetFunction.CountIfs(ColBG, c) 'Error here
        If n = 1 Then
            c.Offset(0, -1).Resize(1, 3).Copy
            HosKvikOffIns.PasteSpecial xlPasteAll
            Set HosKvikOffIns = HosKvikOffIns.Offset(1, 0)
        End If
    End If
Next

我应该在 "If c Is" 行中写什么来让宏执行我想要它执行的操作？我是否有可能循环两个不同的范围，并且只有 return 范围 G 中的任何 xlUniqueValue？

Answer 1

Countif 的范围不正确。

Sub LoopForCondFormatCells()

    Dim sht3 As Worksheet, sht4 As Worksheet
    Dim ColB As Range, ColG As Range, ColBG As Range, c As Range
    Dim Wf As WorksheetFunction
    Dim vR() As Variant
    Dim k As Long, j As Integer

    Set Wf = WorksheetFunction

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

    Set ColG = sht3.Range("B3:B88")
    Set ColB = sht3.Range("G3:G86")
    'ColBG1 = ColB & "," ColG
    'Set ColBG = Union(ColG, ColB)
'In the following For Each strings, I would like it to look in the range ColBG, _
but it should only return the value it finds in ColB... _
But I don't know how to write the code to do so
For Each c In ColB.Cells
    If Not IsEmpty(c) Then
        With Wf
            n = .CountIfs(ColG, c) 'Error here
            If n = 0 Then
                k = k + 1
                ReDim Preserve vR(1 To 3, 1 To k)
                For j = 1 To 3
                    vR(j, k) = c.Offset(0, j - 2)
                Next j
            End If
        End With
    End If
Next
sht4.Range("a1").Resize(k, 3) = Wf.Transpose(vR) '<~~The unique values  are written below cell a1 in Sheet 4.
End Sub

上面是用数组比较快，下面是复制范围的方法

Sub LoopForCondFormatCells()

    Dim sht3 As Worksheet, sht4 As Worksheet
    Dim ColB As Range, ColG As Range, ColBG As Range, c As Range
    Dim Wf As WorksheetFunction
    Dim vR() As Variant
    Dim k As Long, j As Integer
    Dim HosKvikOffIns As Range '<~~Declare a variable

    Set Wf = WorksheetFunction

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

    Set ColG = sht3.Range("B3:B88")
    Set ColB = sht3.Range("G3:G86")

    Set HosKvikOffIns = sht4.Range("a1") '<~~ First, set the varialble
For Each c In ColB.Cells
    If Not IsEmpty(c) Then
        With Wf
            n = .CountIfs(ColG, c) 'Error here
            If n = 0 Then
                c.Offset(0, -1).Resize(1, 3).Copy HosKvikOffIns
                Set HosKvikOffIns = HosKvikOffIns.Offset(1, 0)
            End If
        End With
    End If
Next

End Sub

Excel VBA 遍历 2 列，只复制符合条件的一个范围内的单元格

Excel VBA loop through 2 columns and only copy cells of one range that meets criteria

excel

foreach

vba

conditional-formatting