小女子求助:条件格式颜色计数VBA(已更新问题)

yoursister

jiangxiaoyun 发表于 2019-3-13 09:29
Sub gf()
    Dim d As Object, i&, a, j&, s
    Set d = CreateObject("scripting.dictionary")

拜谢大神花时间写代码相助！
请教：是否：把您写的这些代码直接替换我原来的代码，即可？

micch

yoursister 发表于 2019-3-13 15:21
拜谢大神！一个疑问："根据条件格式计数就行，不用自定义函数"，
这样是不是要求："主表"工作表、"色"工 ...

字体字号什么的公式理解不了，除了极个别函数，是不会受影响的，至于小数点，影响不影响要根据条件来，lookup函数理解一下，只要分级条件清晰，小数不影响函数

yoursister

micch 发表于 2019-3-13 15:24
字体字号什么的公式理解不了，除了极个别函数，是不会受影响的，至于小数点，影响不影响要根据条件来，lo ...

感谢大神指教，我试试

microyip

换种思路，不去对比颜色，直接对比比较数值就好啦

microyip

1. Function MicroColor(ByVal Target As Range) As Integer
   
2.     Dim vFormula As Variant, nI As Integer
   
3.     Dim vData As Variant, nRow As Integer, nCol As Integer
   
4.     Dim nScore As Integer, nResult As Integer, sFormula As String
   
5.    
   
6.     vFormula = Sheets("色").UsedRange.Value
   
7.     vData = Target.Value
   
8.     For nRow = 1 To UBound(vData)
   
9.         For nCol = 1 To UBound(vData, 2)
   
10.             nScore = Val(vData(nRow, nCol))
    
11.             For nI = 2 To UBound(vFormula)
    
12.                 sFormula = Trim(vFormula(nI, 2))
    
13.                 If Not (sFormula Like "*分数" Or sFormula Like "分数*") Then sFormula = "And(" & Replace(sFormula, "分数", "分数,分数") & ")"
    
14.                 If Not IsError(Evaluate(Replace(sFormula, "分数", nScore))) Then
    
15.                     If Evaluate(Replace(sFormula, "分数", nScore)) Then
    
16.                         nResult = nResult + Val(vFormula(nI, 1))
    
17.                     End If
    
18.                 End If
    
19.             Next
    
20.         Next
    
21.     Next
    
22.     MicroColor = nResult
    
23. End Function

复制代码

microyip

附上附件以供参考，PS：建议以后不要在WPS里使用OFFICE的VBA

yoursister

microyip 发表于 2019-3-13 16:19
附上附件以供参考，PS：建议以后不要在WPS里使用OFFICE的VBA

谢谢大神，我上传的附件是极度精简演示版，实际上不得不用颜色赋值的

microyip

yoursister 发表于 2019-3-13 16:32
谢谢大神，我上传的附件是极度精简演示版，实际上不得不用颜色赋值的

你就参考一下，研究一下思路就是了，你是研究生，比我研究得东西多，这么简单的问题，对你来说根本就不是什么问题

yoursister

micch 发表于 2019-3-13 09:35
选择单元格快捷方式，Ctrl+shift+↓是向下全选，Ctrl+shift+→是向右全选，选中后清除就可以了

选择单元格快捷方式，Ctrl+shift+↓是向下全选，Ctrl+shift+→是向右全选，选中后清除就可以了

原来.XLSM大约11MB大，按上述方法清除之后达到18MB大。。。[捂脸][捂脸][捂脸]。。。

yoursister

micch 发表于 2019-3-13 09:35
选择单元格快捷方式，Ctrl+shift+↓是向下全选，Ctrl+shift+→是向右全选，选中后清除就可以了

我又试了一下，把数据区里的无效第一个都按您的方法清除了，目前.XLSM大小降低到了7MB，哈哈哈，感谢大神您