Sub添加條件格式()
    Dim rng As Range
    Set rng=Rows("1:" & Range("a1").End(xlUp).Row)
    With rng
      .FormatConditions.Delete  '如果已有條件格式，將之刪除
      .FormatConditions.Add Type:=xlExpression,
            Formula1:="=ROW()=CELL(""row"")"  '添加公式
      .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
            '將此條件格式規則的優先級值設置為“1”
      With .FormatConditions(1).Font
          .ThemeColor=xlThemeColorAccent6   '指定要使用的主題顏色
          .TintAndShade=0.1'條件格式規則單元格的填充顏色變淺或變深的設置參數
      End With
    End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Cells.Font.ColorIndex=xlAutomatic
Cells.Font.TintAndShade=0
    With Target.EntireRow.Font
      .ThemeColor=xlThemeColorAccent6
      .TintAndShade=-0.249977111117893
    End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Application.ScreenUpdating=False
    ActiveSheet.UsedRange.Font.Name="宋體"
    For Each rng In Application.Intersect(Range("b:b"),
        ActiveSheet.UsedRange.Offset(2, 0))
    If rng="男" Then
    rng.Resize(1, 5).Font.Name="Arial Black"
    End If
    Next
    Application.ScreenUpdating=True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    For Each rng In Application.Intersect(Range("f:f"),
        ActiveSheet.UsedRange.Offset(2, 0))
    If rng="優" Then
    With rng.Offset(0,-5).Interior
      .ThemeColor=xlThemeColorDark1
      .TintAndShade=-0.149998474074526
      .PatternTintAndShade=0
    End With
    End If
    Next
End Sub

Sub添加條件格式()
    Cells.FormatConditions.Delete
    Dim rng As Range
    Set rng=Application.Intersect(Range("a:a"),
        ActiveSheet.UsedRange.Offset(2, 0), ActiveSheet.UsedRange)
    With rng
      .Select
      .FormatConditions.Add Type:=xlExpression, Formula1:=_
      "=OFFSET(A3,,4)=MAX($E:$E)"
      .FormatConditions(.FormatConditions.Count).SetFirstPriority
      With .FormatConditions(1).Font
          .Underline=xlUnderlineStyleSingle
          .TintAndShade=0
      End With
      .FormatConditions(1).StopIfTrue=False
    End With
End Sub

Sub對區域中超過平均值之數據加粗傾斜()
    Range("E3:E" & [e1048576].End(xlUp).Row).Select
    With Selection
      .FormatConditions.AddAboveAverage             '添加條件格式
      .FormatConditions(1).AboveBelow=xlAboveAverage '類型
      With .FormatConditions(1).Font               '字體加粗/傾斜
          .Bold=True
          .Italic=True
      End With
    End With
End Sub

Sub添加圖標集條件格式()
    Range("E3:E" & [e1048576].End(xlUp).Row).Select
    With Selection
      .FormatConditions.AddDatabar  '添加圖標集條件格式規則
      .FormatConditions(.FormatConditions.Count).SetFirstPriority
                                      '設定優先級別
      .FormatConditions(1).BarColor.ColorIndex=5  '指定顏色值
    End With
End Sub

Sub圖標條件格式()
    Range("C3:C" & [C1048576].End(xlUp).Row).Select  '對C列設置條件格式
    With Selection
      .FormatConditions.Delete               '刪除以前的條件格式
      .FormatConditions.AddIconSetCondition  '添加條件格式
      .FormatConditions(.FormatConditions.Count).SetFirstPriority
      With .FormatConditions(1)
        .IconSet=ActiveWorkbook.IconSets(xl3TrafficLights1) '圖標樣式
      End With
      With .FormatConditions(1).IconCriteria(2)
          .Type=xlConditionValuePercent      '使用百分比
          .Value=60
          .Operator=7          '指定條件格式的操作符，位置7表示大于且等于
      End With
      With .FormatConditions(1).IconCriteria(3)
          .Type=xlConditionValuePercent
          .Value=90
          .Operator=7
      End With
    End With
End Sub

Sub將重復值加上虛框()
    Range("E3:E" & [E1048576].End(xlUp).Row).Select
    With Selection
      .FormatConditions.AddUniqueValues
      .FormatConditions(1).DupeUnique=xlDuplicate
      .FormatConditions(1).Borders.LineStyle=xlDot
    End With
End Sub

Sub查找羅并標示紅圈2() '效率更高
  Dim Cell As Range
  For Each Cell In Range("A1:H50")
    If Cell Like "羅*" Then
  With Worksheets(1).Ovals.Add(Cell.Left,Cell.Top,Cell.Width,Cell.Height)
      .Interior.Pattern=xlNone
      .Border.ColorIndex=3
      End With
      End If
  Next
End Sub

Sub圈釋目標() '數據有效性方法
    With Range("a3:A" & Range("A1048576").End(xlUp).Row).Validation
    .Delete     '刪除數據有效性
    .Add Type:=xlValidateCustom,AlertStyle:=xlValidAlertStop,Operator:=_
      xlBetween, Formula1:="=left(A3,1)<>""羅"""     '添加數據有效性
      .IgnoreBlank=True      '允許空值
      .InCellDropdown=True    '顯示含有有效取值的下拉列表
    End With
    ActiveSheet.CircleInvalid  '圈釋無效數據
End Sub