Excel VBA遍历两列筛选xlUniqueValues单元格遇1004错误的技术问询

Hey there! Let's work through your VBA conditional formatting problem together. I'll break down how to detect xlUniqueValues conditional formatting and how to extract the data you need from two ranges in column G.

In VBA, the "Unique Values" conditional format is actually categorized under the xlTop10 type, with an operator set to xlUnique. To reliably check this, you can create a helper function that loops through a cell's format conditions:

Function IsUniqueValueCF(cell As Range) As Boolean
    Dim cf As FormatCondition
    ' Loop through all conditional formats applied to the cell
    For Each cf In cell.FormatConditions
        ' Verify it's the "Unique Values" rule
        If cf.Type = xlTop10 And cf.Operator = xlUnique Then
            IsUniqueValueCF = True
            Exit Function ' No need to check further once found
        End If
    Next cf
    ' If no matching format was found
    IsUniqueValueCF = False
End Function

This function returns True if the cell has the unique-values conditional format applied, and False otherwise.

Now, let's put this function to use in a subroutine that targets your two ranges in column G, copies the left-side content of matching cells, and pastes it to the "Print ready" sheet:

Sub ExtractUniqueCFData()
    Dim wsCompare As Worksheet
    Dim wsPrint As Worksheet
    Dim targetRanges As Variant
    Dim currentRange As Range
    Dim cell As Range
    Dim nextPasteRow As Long
    
    ' Set up your worksheet references
    Set wsCompare = ThisWorkbook.Worksheets("Compare")
    Set wsPrint = ThisWorkbook.Worksheets("Print ready")
    nextPasteRow = 2 ' Start pasting at row 2 (adjust if your header is in row 1)
    
    ' Define the two column G ranges you want to check (replace with your actual ranges)
    targetRanges = Array(wsCompare.Range("G2:G150"), wsCompare.Range("G152:G300"))
    
    ' Loop through each defined range
    For Each currentRange In targetRanges
        For Each cell In currentRange
            ' Check if the cell has the unique-values conditional format
            If IsUniqueValueCF(cell) Then
                ' Copy the content to the left of the cell (adjust Offset to match your needs)
                ' Example: Offset(0, -1) = column F; use Offset(0, -3) for column D, etc.
                cell.Offset(0, -1).Copy
                
                ' Paste values and formatting to the Print ready sheet (here we use column A)
                wsPrint.Cells(nextPasteRow, "A").PasteSpecial xlPasteValuesAndNumberFormats
                nextPasteRow = nextPasteRow + 1 ' Move to the next empty row for pasting
            End If
        Next cell
    Next currentRange
    
    ' Clean up the clipboard
    Application.CutCopyMode = False
    MsgBox "Unique value data extracted successfully!", vbInformation
End Sub

Key Notes: #

• Adjust the targetRanges array to match your actual column G ranges in the "Compare" sheet.
• Modify the Offset(0, -1) part if you need to copy more than just the immediate left column (e.g., use cell.EntireRow.Range("A:F") to copy columns A-F for the matching row).
• This approach avoids the CountIfs error you encountered earlier, since we're directly checking the conditional format properties instead of relying on worksheet functions.

内容的提问来源于stack exchange，提问作者Patrick S