2016-03-15 275 views
1

我有一个公共函数我试图运行,看看列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 
+0

如何你打电话的功能? –

+0

我在我的子模块中调用了ColorIndex –

+0

通过单击VBA编辑器的边界内部,可以启用一个断点,这将暂停执行VBA代码。如果是这种情况,那么您确定已经执行了您的代码。如果没有,你可能需要调查为什么你的代码没有执行。 – Dominique

回答

2

就像我说在我的意见,你不能使用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 
+0

啊好吧,所以创建一个子和在命令按钮下面调用原始子版本中的sub ... gotcha非常感谢! –

+0

我在Sub ColorIndex代码中收到Invalid Next控件变量引用 –

+1

糟糕。我忘了更改两个字母 - 现在应该修复。 – Vegard