条件付き書式からすべての色付きセルを選択

Question

条件付き書式に基づいて色付けされたすべてのセルを選択するために、マクロを使用する必要があるシート「要約」にセル範囲（K6：M200）があります。以下の条件があります。

1. 色付きセルは、条件を満たす行がない限り、K6から連続しています。
2. すべてのセルが同じ色になるわけではありません。

私はVBAとマクロが新しく、誰かがこれを行う方法を理解するのを助けてくれることを願っています。私はすでにいくつかの式を試してきましたが、うまくいきませんでした。

Answer 1

私は最初の値を知っている、と私のマクロの一部は、以前に色付けされます全体の範囲を選択するので、私はこれらの2つの値を使用してから作業する範囲を構築することができ、ことに気づきました。

だから私はやった：

Dim r1 As Range, r2 As Range 
Set r1 = Selection 
Set r2 = ActiveSheet.Range("K6") 
Range(r2, r1).Select 

そしてそれは働きました。私はこの間違いに近づいていた。

Answer 2

私はこのようなものをお勧めしたい：

Sub selectCFColours() 
    Dim cell As Range 
    Dim selRange As Range 

    For Each cell In Range("K6:M200") 
     If cell.DisplayFormat.Interior.Color <> cell.Interior.Color Then 
      If selRange Is Nothing Then 
       Set selRange = cell 
      Else 
       Set selRange = Union(selRange, cell) 
      End If 
     End If 
    Next 

    If Not selRange Is Nothing Then selRange.Select 
End Sub 

Answer 3

次のコードは、汎用のfindAllコードのためです。これは、条件付き書式で使用できるようにApplication.FindFormatを設定することによっても使用できます。

Sub FindBlack() 
    Dim FoundRange As Range 

    With Application.FindFormat 
     .Clear 
     .Interior.Color = RGB(0, 0, 0) 
    End With 
    Set FoundRange = FindAll("", LookIn:=xlFormulas, SearchWhat:=Range("K6:M200"), SearchFormat:=True) 

    If Not FoundRange Is Nothing Then Debug.Print FoundRange.Address 
End Sub 

Function FindAll(What, _ 
    Optional SearchWhat As Variant, _ 
    Optional LookIn, _ 
    Optional LookAt, _ 
    Optional SearchOrder, _ 
    Optional SearchDirection As XlSearchDirection = xlNext, _ 
    Optional MatchCase As Boolean = False, _ 
    Optional MatchByte, _ 
    Optional SearchFormat) As Range 

    'LookIn can be xlValues or xlFormulas, _ 
    LookAt can be xlWhole or xlPart, _ 
    SearchOrder can be xlByRows or xlByColumns, _ 
    SearchDirection can be xlNext, xlPrevious, _ 
    MatchCase, MatchByte, and SearchFormat can be True or False. _ 
    Before using SearchFormat = True, specify the appropriate settings for the Application.FindFormat _ 
    object; e.g. Application.FindFormat.NumberFormat = "General;-General;""-""" 

    Dim SrcRange As Range 
    If IsMissing(SearchWhat) Then 
     Set SrcRange = ActiveSheet.UsedRange 
    ElseIf TypeOf SearchWhat Is Range Then 
     Set SrcRange = IIf(SearchWhat.Cells.Count = 1, SearchWhat.Parent.UsedRange, SearchWhat) 
    ElseIf TypeOf SearchWhat Is Worksheet Then 
     Set SrcRange = SearchWhat.UsedRange 
    Else: SrcRange = ActiveSheet.UsedRange 
    End If 
    If SrcRange Is Nothing Then Exit Function 

    'get the first matching cell in the range first 
    With SrcRange.Areas(SrcRange.Areas.Count) 
     Dim FirstCell As Range: Set FirstCell = .Cells(.Cells.Count) 
    End With 

    Dim CurrRange As Range: Set CurrRange = SrcRange.Find(What:=What, After:=FirstCell, LookIn:=LookIn, LookAt:=LookAt, _ 
     SearchDirection:=SearchDirection, MatchCase:=MatchCase, MatchByte:=MatchByte, SearchFormat:=SearchFormat) 

    If Not CurrRange Is Nothing Then 
     Set FindAll = CurrRange 
     Do 
      Set CurrRange = SrcRange.Find(What:=What, After:=CurrRange, LookIn:=LookIn, LookAt:=LookAt, _ 
      SearchDirection:=SearchDirection, MatchCase:=MatchCase, MatchByte:=MatchByte, SearchFormat:=SearchFormat) 
      If CurrRange Is Nothing Then Exit Do 
      If Application.Intersect(FindAll, CurrRange) Is Nothing Then 
       Set FindAll = Application.Union(FindAll, CurrRange) 
      Else: Exit Do 
      End If 
     Loop 
    End If 
End Function