使用计数时出错

时间:2017-07-26 08:48:52

标签: excel vba excel-vba

我有一张表"结果"我正在计算" Green"," red"和""列中的值" K"我的床单。然后我在我的工作表" status"中打印此值。在工作表状态我有一个表A列作为周数。因此,如果表格A中的周数为#34;状态"与表格中的周数相同"结果"列O,然后我开始计算列K

中的值

我有代码工作,但我迷路了,由于某种原因,我收到的计数值不正确。对于例如"绿色"我在结果列K中有73行绿色。但我可以看到它印在我的表格中#34; status"为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

1 个答案:

答案 0 :(得分:1)

我在代码中工作,发现循环中存在不规则性。您的变量I和j似乎在计算行和有效行。因此,我重命名了这些变量,以明确它们是行。此外,您的代码会测试每一行的红色,绿色和&#34;&#34;。我认为它只能是其中之一。因此,如果一个匹配,则其他两个不匹配。这可能导致重复计算。最后,我发现你似乎将最终结果写入状态表,在同一个单元格中,很多次。

对不起,以下代码未经过测试,因为我没有数据。但我试图解决上述问题。

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

我建议您在工作表顶部使用Option Explicit并声明您使用的每个变量。