如果公式格式化单元格

Question

我有一个公共函数我试图运行，看看列C中的格式，并将一个基于G列格式的值与点击一个命令按钮。我想用黄色突出显示的行来获得一个零，那些没有内部并且没有删除线的可以获得一个。我写了下面的代码，但是当我点击命令按钮时，什么也没有发生。不知道我的代码是否在正确的位置或错误的语法？任何和所有的帮助表示赞赏。

Sub Resort() 
Dim ws As Worksheet 
Dim rng As Range 
Dim urng As Range 
Dim rng1 As Range 
Dim shCmt As Comment 
Set ws = Worksheets("Workbench Report") 
lastrow = ws.Cells(ws.Rows.count, "D").End(xlUp).Row 

ws.Select 
ws.Range(Cells(2, "B"), Cells(Cells(2, "E").End(xlDown).Row, "G")).Sort _ 
key1:=ws.Range("E1"), order1:=xlAscending, Header:=xlYes, Orientation:=xlSortColumns 

ws.Columns("E:E").EntireColumn.AutoFit 
ws.Columns("E:E").ColumnWidth = 6.86 

ws.Select 
For Each rng In ws.Range("C2:C" & lastrow) 
If rng.Interior.Color = 65535 Then 
If urng Is Nothing Then 
Set urng = ws.Range("E" & rng.Row) 
Else 
Set urng = Union(urng, ws.Range("E" & rng.Row)) 
End If 
End If 
Next rng 

If Not urng Is Nothing Then urng.copy 

ws.Range("B" & Cells.Rows.count).End(xlUp).Offset(2, 3).PasteSpecial xlPasteValues 

ws.Range("H2").PasteSpecial xlPasteValues 

ws.Range("B" & Cells.Rows.count).End(xlUp).Offset(2, 2).Select 
Selection.Formula = "=IF(H2>0,COUNTIF(E:E,H2)-2,"""")" 
Selection.HorizontalAlignment = xlCenter 
Selection.copy 
Selection.PasteSpecial Paste:=xlPasteValues 

ws.Range("B" & Cells.Rows.count).End(xlUp).Offset(3, 2).Select 
Selection.Formula = "=IF(H3>0,COUNTIF(E:E,H3)-2,"""")" 
Selection.HorizontalAlignment = xlCenter 
Selection.copy 
Selection.PasteSpecial Paste:=xlPasteValues 

ws.Range("B" & Cells.Rows.count).End(xlUp).Offset(4, 2).Select 
Selection.Formula = "=IF(H4>0,COUNTIF(E:E,H4)-2,"""")" 
Selection.HorizontalAlignment = xlCenter 
Selection.copy 
Selection.PasteSpecial Paste:=xlPasteValues 

ws.Range("B" & Cells.Rows.count).End(xlUp).Offset(5, 2).Select 
Selection.Formula = "=IF(H5>0,COUNTIF(E:E,H5)-2,"""")" 
Selection.HorizontalAlignment = xlCenter 
Selection.copy 
Selection.PasteSpecial Paste:=xlPasteValues 

ws.Range("B" & Cells.Rows.count).End(xlUp).Offset(6, 2).Select 
Selection.Formula = "=IF(H6>0,COUNTIF(E:E,H6)-2,"""")" 
Selection.HorizontalAlignment = xlCenter 
Selection.copy 
Selection.PasteSpecial Paste:=xlPasteValues 

ws.Columns("H").ClearContents 

SendKeys ("{ESC}") 

ws.Select 
ws.Range("E2").Select 
End Sub 

Public Function ColorIndex(rng As Range) As Boolean 

For Each rng In ws.Range("C2:C" & lastrow) 
If rng.Interior.Color = 65535 Then 
ws.Range("G" & rng.Row).Value = "0" 
End If 
Next rng 

For Each rng In ws.Range("C2:C" & lastrow) 
If rng.Interior.Color = xlNone And rng.Font.Strikethrough = False Then 
ws.Range("G" & rng.Row).Value = "1" 
End If 
Next rng 

End Function 

Answer 1

就像我说在我的意见，你不能使用Function作用于多个小区，你已经做的方式。你有两个选择。 （a）重写以使函数仅作用于参数中提供的单元格。
（b）改为拨打Sub，即可从命令按钮调用。

这里的函数的外观：

Function ColorIndex(rng As Range) As Boolean 
    If rng.Item(1).Interior.Color = 65535 Then ColorIndex = "0" 
    If rng.Item(1).Interior.Color = 16777215 And rng.Item(1).Font.Strikethrough = False Then ColorIndex = "1" 
End Function 

放入G列，就像这样：=ColorIndex(C2)，并填写了下来。

这里的子会怎样看：

Sub ColorIndex(rng As Range) 
    For Each r In rng 
     If r.Interior.Color = 65535 Then ws.Range("G" & r.Row).Value = "0" 
     If r.Interior.Color = 16777215 And r.Font.Strikethrough = False Then ws.Range("G" & r.Row).Value = "1" 
    Next r 
End Sub 

分配到命令按钮宏：

Sub buttonColorIndex() 
    Call ColorIndex(ws.Range("C2:C" & lastrow)) 
End Sub 

编辑：我知道你没有问这个问题，但这里有一个建议在代码中进行其他优化。

你有几段这样看：

ws.Range("B" & Cells.Rows.count).End(xlUp).Offset(2, 2).Select 
Selection.Formula = "=IF(H2>0,COUNTIF(E:E,H2)-2,"""")" 
Selection.HorizontalAlignment = xlCenter Selection.copy 
Selection.PasteSpecial Paste:=xlPasteValues 

所有的人都删除，并尝试这个：

With ws.Range("B" & Cells.Rows.Count).End(xlUp) 
    For i = 2 To 6 
     With .Offset(i, 2) 
      .Value = ws.Evaluate("IF(H3>0,COUNTIF(E:E,H" & i & ")-2,"""")") 
      .HorizontalAlignment = xlCenter 
     End With 
    Next i 
End With