2016-04-22 19 views
-3

Picture of some data条件付き書式ここ

私の要件 それぞれの1だけの最低値(最低値が複数のセルにある場合)すべての行が青色で、その色を変更します 2の場合最も低い値は、セルが黄色を有する1つの色のみにある。

これらはすべて、各行の最小値を持つセルのみで行われます。

+1

具体的な問題はありますか? – flohdieter

+1

質問を投稿してください。どのような問題がありますか、何を試しましたか?あなたはすでに書かれたコードを持っていますか? –

+0

ホームタブに条件付き書式設定があります。それを見れば、すべてが明らかになるでしょう –

答えて

0

以下の式Iを列A〜Nに設定し、必要に応じて調整します。

条件付きフォーマットの両方のこれらの規則を持つセルA1(必要に応じて調整する):と


=IF(IF(A1=SMALL($A1:$N1,1),COUNTIF($A1:$N1,SMALL($A1:$N1,1)),0)>=2,1,0) 

マークこれは「Trueの場合停止」と黄色の背景に色を。同じセルに対する


次のルール:

=IF(A1=SMALL($A1:$N1,1),1,0) 

カラー背景青色。


その行の他のセルにルールをコピーする書式ペインタを使用します。

セルは、必要に応じて背景色を変更する必要があります。

0

これを試してください。それは完璧ではありませんが、あなたが望むことをする必要があります。

Sub ConditionalFormat() 

    With Application 
     .ScreenUpdating = False 
     .Calculation = xlCalculationManual 
    End With 

    Dim ws As Worksheet 
    Dim x As Integer, u As Integer, myCount As Integer 
    Dim lRow As Long, lColumn As Long 
    Dim myMin As Double 
    Set ws = Worksheets("Sheet1") 

    With ws 
     'Count last row 
     lRow = .Cells.Find(What:="*", _ 
      After:=.Cells(1, 1), _ 
      LookAt:=xlPart, _ 
      LookIn:=xlFormulas, _ 
      SearchOrder:=xlByRows, _ 
      SearchDirection:=xlPrevious, _ 
      MatchCase:=False).Row 
     'Count last column 
     lColumn = .Cells.Find(What:="*", _ 
      After:=.Cells(1, 1), _ 
      LookAt:=xlPart, _ 
      LookIn:=xlFormulas, _ 
      SearchOrder:=xlByColumns, _ 
      SearchDirection:=xlPrevious, _ 
      MatchCase:=False).Column 
     'Remove currency numberformat 
     .Range(.Cells(1, 1), .Cells(lRow, lColumn)).NumberFormat = "General" 

     For x = 1 To lRow 
      'Find smallest value and count how many times it shows up 
      myMin = Application.WorksheetFunction.Min(.Rows(x)) 
      myCount = Application.WorksheetFunction.CountIf(.Rows(x), myMin) 
      'Color cells that appear more than once blue 
      If myCount > 1 Then 
       For u = 1 To lColumn 
        If .Cells(x, u).Value = myMin Then 
         .Cells(x, u).Interior.Color = 15773696 
        End If 
       Next u 
      'Color cells that appear once yellow 
      ElseIf myCount = 1 Then 
       For u = 1 To lColumn 
        If .Cells(x, u).Value = myMin Then 
         .Cells(x, u).Interior.Color = 65535 
         Exit For 
        End If 
       Next u 
      End If 
     Next x 
    'Return currency format 
    .Range(.Cells(1, 1), .Cells(lRow, lColumn)).NumberFormat = "[$£-809]#,##0.00" 

    End With 

    With Application 
     .ScreenUpdating = True 
     .Calculation = xlCalculationAutomatic 
    End With 

End Sub 
関連する問題