Vba 使用计数时出错

我有一张“结果”表，我正试图计算表中“K”列中“绿色”、“红色”和“”值的数量。然后，我在我的“状态”表中打印此值。在“工作表状态”中，我有一个列为周数的表。因此，如果工作表“状态”的A列中的周数与O列的工作表“结果”中的周数相同，那么我开始计算K列中的值

我有代码工作，但我丢失了，由于某种原因，我收到的计数值不是正确的。对于例如“绿色”，我在结果的K列中有73行绿色。但我可以在我的“状态”表上看到它是71

谁能帮我找出哪里出了问题

Sub result()
Dim i As Integer
Dim j As Integer
Dim cnt As Integer
Dim cntu As Integer
Dim sht As Worksheet
Dim totalrows As Long
Set sht = Sheets("Status")
Sheets("Result").Select
totalrows = Range("E5").End(xlDown).Row
n = Worksheets("Result").Range("E5:E" & totalrows).Cells.SpecialCells(xlCellTypeConstants).Count
For i = 2 To WorksheetFunction.Count(sht.Columns(1))
cntT = 0
cntu = 0
cntS = 0
If sht.Range("A" & i) = Val(Format(Now, "WW")) Then Exit For
Next i
 For j = 5 To WorksheetFunction.CountA(Columns(17))
 If sht.Range("A" & i) = Range("Q" & j) And Range("K" & j) = "Green" Then cntT = cntT + 1
 If sht.Range("A" & i) = Range("Q" & j) And Range("K" & j) = "Red" Then cntu = cntu + 1
 If sht.Range("A" & i) = Range("Q" & j) And Range("F" & j) = "" Then cntS = cntS + 1
If cntT <> 0 Then sht.Range("C" & i) = cntT
If cntu <> 0 Then sht.Range("D" & i) = cntu
If cntS <> 0 Then sht.Range("B" & i) = cntS
If n <> 0 Then sht.Range("G" & i) = n
Next j
If cntR + cntu <> 0 Then
'sht.Range("D" & i) = cntR / cntu * 100
End If
End Sub

子结果（）
作为整数的Dim i
作为整数的Dim j
作为整数的Dim cnt
作为整数的Dim cntu
将sht变暗为工作表
所有行的长度相同
设置sht=图纸（“状态”）
工作表（“结果”）。选择
totalrows=范围（“E5”）。结束（xlDown）。行
n=工作表（“结果”）.范围（“E5:E”和totalrows）.单元格.特殊单元格（xlCellTypeConstants）.计数
对于i=2到工作表function.Count（短列（1））
cntT=0
cntu=0
碳纳米管=0
如果sht.Range（“A”&i）=Val（格式（现在为“WW”）），则退出
接下来我
对于工作表function.CountA中的j=5（列（17））
如果短程（“A”&i）=短程（“Q”&j）和短程（“K”&j）=绿色，则cntT=cntT+1
如果短程（“A”&i）=短程（“Q”&j）和短程（“K”&j）=红色，则cntu=cntu+1
如果短程（“A”&i）=短程（“Q”&j）和短程（“F”&j）=”，则cntS=cntS+1
如果cntT为0，则短范围（“C”&i）=cntT
如果cntu为0，则短范围（“D”&i）=cntu
如果碳纳米管为0，则短范围（“B”&i）=碳纳米管
如果n为0，则短程范围（“G”&i）=n
下一个j
如果cntR+cntu为0，则
'短范围（“D”&i）=cntR/cntu*100
如果结束
端接头

我仔细检查了您的代码，发现您的循环中存在不规则之处。变量I和j似乎同时计算行数和有效行数。因此，我重命名了这些变量，以明确它们是行。此外，您的代码还测试每一行的红色、绿色和“”。我认为这只能是其中之一。因此，如果其中一个匹配，那么其他两个就不能匹配。这可能导致重复计算。最后，我发现您似乎在同一个单元格中多次将最终结果写入状态表

很抱歉，以下代码未经测试，因为我没有数据。但我已尝试解决上述问题

Option Explicit

Sub MyResult()          ' "Result" is a word reserved for the use of  VBA

    Dim cntT As Integer, cntU As Integer, cntS As Integer
    Dim WsStatus As Worksheet, WsResult As Worksheet
    Dim TotalRows As Long
    Dim Rs As Integer, Rr As Long               ' RowCounters: Status & Result
    Dim n As Integer

    Set WsStatus = Sheets("Status")
    Set WsResult = Sheets("Result")
    TotalRows = Range("E5").End(xlDown).Row
    n = WsResult.Range("E5:E" & TotalRows).Cells.SpecialCells(xlCellTypeConstants).Count
'   Improper counting: Rs is not necessarily aligned with the row number:
'    For Rs = 2 To WorksheetFunction.Count(WsStatus.Columns(1))

    For Rs = 2 To TotalRows
        If WsStatus.Cells(Rs, "A").Value = Val(Format(Now, "WW")) Then Exit For
'        If WsStatus.Range("A" & Rs) = Val(Format(Now, "WW")) Then Exit For
    Next Rs

'   Improper counting: Rr is not necessarily aligned with the row number:
'     For Rr = 5 To WorksheetFunction.CountA(Columns(17))

    With WsStatus
        For Rr = 5 To TotalRows
            If (.Cells(Rs, "A").Value = .Cells(Rs, "Q").Value) Then
                If (.Cells(Rs, "K").Value = "Green") Then
                    cntT = cntT + 1
                ElseIf (.Cells(Rs, "K").Value = "Red") Then
                    cntU = cntU + 1
                Else
                     If (.Cells(Rs, "A").Value = "") Then cntS = cntS + 1
                End If
            End If
        Next Rr
    End With

    With WsResult.Rows(Rs)
        ' it would be better to write even 0 to these cells
        ' if you don't want to show 0, format the cell to hide zeroes
        .Cells(2).Value = IIf(cntS, cntS, "")       ' 2 = B
        .Cells(3).Value = IIf(cntT, cntT, "")       ' 3 = C
        .Cells(4).Value = IIf(cntU, cntU, "")       ' 4 = D
        .Cells(7).Value = IIf(n, n, "")             ' 7 = G
    End With
    '    If cntR + cntU <> 0 Then                   ' cntR isn't defined
        'WsStatus.Range("D" & Rs) = cntR / cntu * 100
    End If
End Sub

选项显式
Sub MyResult（）““Result”是为VBA使用而保留的字
Dim cntT为整数，cntU为整数，cntS为整数
将WsStatus设置为工作表，WsResult设置为工作表
所有行的长度相同
Dim Rs为整数，Rr为长行计数器：状态和结果
作为整数的Dim n
设置WsStatus=工作表（“状态”）
设置WsResult=工作表（“结果”）
TotalRows=范围（“E5”）。结束（xlDown）。行
n=WsResult.Range（“E5:E”和TotalRows）.Cells.SpecialCells（xlCellTypeConstants）.Count
'计数不正确：Rs不一定与行号对齐：
'对于Rs=2到工作表function.Count（WsStatus.Columns（1））
对于Rs=2到总计行
如果WsStatus.Cells（Rs，“A”）.Value=Val（格式（现在为“WW”）），则退出
'如果WsStatus.Range（“A”&Rs）=Val（格式（现在为“WW”）），则退出
下一个Rs
'计数不正确：Rr不一定与行号对齐：
'对于Rr=5到工作表function.CountA（第17列））
具有WsStatus
对于Rr=5到TotalRows
如果（.Cells（Rs，“A”）.Value=.Cells（Rs，“Q”）.Value），则
如果（.Cells（Rs，“K”）.Value=“绿色”），则
cntT=cntT+1
ElseIf（.Cells（Rs，“K”）.Value=“Red”）然后
cntU=cntU+1
其他的
如果（.Cells（Rs，“A”）.Value=“”），则cntS=cntS+1
如果结束
如果结束
下一个Rr
以
使用WsResult.Rows（Rs）
'最好将0写入这些单元格
'如果不想显示0，请格式化单元格以隐藏零
.单元（2）.值=IIf（碳纳米管，碳纳米管，“”）2=B
.单元格（3）.值=IIf（cntT，cntT，“”）3=C
.单元格（4）.值=IIf（cntU，cntU，“”）4=D
.单元格（7）.值=IIf（n，n，“”）7=G
以
'如果cntR+cntU 0，则未定义'cntR'
'WsStatus.Range（“D”&Rs）=cntR/cntu*100
如果结束
端接头

---

我建议您在工作表顶部使用

选项Explicit

，并声明您使用的每个变量。

我建议您使用公式。查看

CountIf

第17列中的函数是什么？

WorksheetFunction.CountA（Columns（17））

的结果是否可能由于宏执行的操作而更改？请尝试在For之前将该值赋给变量。。。下一个循环，这样您就可以确保没有任何东西被计算两次。@Variatus my column 17具有weeknumber。@Variatus column 17不会因宏而改变谢谢您的努力和反馈。当然，如果有任何问题，我会发表评论。而且，如果它是正确的，你会投票吗