6.7-超期问题

当某个问题未解决，且对应的时间节点在查询当天之前则定义为超期问题。所以超期问题，本质上也是一个条件查询。具体方法也是对数据库中每一行进行遍历判断即可。注意，本示例中对没有填写时间节点信息的问题，不做判断。

代码如下

Sub exceedTime()
    Call delAllShape
    
    sizeProblem = 0
    colorProblem = 0
    
    currentDate = Date
    Set sht = ThisWorkbook.Worksheets("问题管理")
    ' 获取行数
    maxRow = sht.Cells(Rows.Count, "Q").End(xlUp).Row
    
    For i = 3 To maxRow Step 1
        problemStatus = sht.Cells(i, "L").Value
        
        If problemStatus = "未解决" Then
            solveDate = sht.Cells(i, "P").Value
            If solveDate <> "" Then
                solveDate = CDate(solveDate)
                If solveDate < currentDate Then
                    shapeName = sht.Cells(i, "Q").Value
                    problemType = sht.Cells(i, "K").Value
                    
                    If problemType = "尺寸" Then
                        shapeType = msoShapeOval
                        sizeProblem = sizeProblem + 1
                    Else
                        shapeType = msoShapeRectangle
                        colorProblem = colorProblem + 1
                    End If
                    positionX = sht.Cells(i, "R").Value
                    positionY = sht.Cells(i, "S").Value
                    widthVal = sht.Cells(i, "T").Value
                    heightVal = sht.Cells(i, "U").Value
                    fillColor = sht.Cells(i, "V").Value
                    lineColor = sht.Cells(i, "W").Value
                    
                    shapeName = drawShape(sht, shapeType, positionX, positionY, widthVal, heightVal, fillColor, lineColor)
                    sht.Cells(i, "Q").Value = shapeName
                End If
            End If
        End If
    Next i
    
    sht.Range("H18") = sizeProblem
    sht.Range("H19") = colorProblem

End Sub
Function drawShape(sht, shapeType, positionX, positionY, widthVal, heightVal, fillColor, lineColor)
    Set newShape = sht.Shapes.AddShape(shapeType, positionX, positionY, widthVal, heightVal)
    shapeName = newShape.Name
    Debug.Print (shapeName)

    With newShape.Fill
        .Visible = msoTrue
        .ForeColor.RGB = fillColor
        .Transparency = 0
        .Solid
    End With

    With newShape.Line
        .Visible = msoTrue
        .ForeColor.RGB = lineColor
        .Transparency = 0
    End With
    
    drawShape = shapeName
End Function