Excel-VBA-质量问题可视化管理-09-多条件查询问题

系统：Windows 10
软件：Excel 2016

• 本系列是假设一种应用场景，键盘质量检查中，发现问题，如何在键盘图片上进行标记和后续的跟踪管理
• 其实也同样适用在其它应用场景，尤其与位置相关的质量特性管理上
• 核心知识点：在背景图片特定位置插入一个圆圈（表示问题点），并对圆圈进行进行颜色等特性的改变

Part 1： 项目功能介绍（更新）

1. 在写的过程中，发现需要修正一下上次的功能，功能模块如下
2. 录入问题（OK）
   • 录入尺寸问题，标记圆形
   • 录入颜色问题，标记矩形
   • 清空显示问题
   • 保存当前状态：新增的问题点位置和颜色都是动态变化的，需要保存最新状态
3. 删除问题（OK）
   • 基于问题唯一ID号删除某问题
4. 查询问题，基于以下三个条件逻辑与进行查询，若无选择条件，默认显示所有问题
   • 基于问题状态：已解决，未解决（OK）
   • 问题种类：尺寸，颜色（OK）
   • 问题ID号，只显示特定ID号问题（OK）
   • 时间节点：超期，未超期
   • 选中图片上问题获取其对应的问题描述
5. 问题修改（OK）
   • 修改问题状态，更新其颜色表示，未解决-红色；已解决-绿色
6. 考虑到操作的便利性，对于录入问题部分，设置快捷键

操作界面（仅做示意，并不表示真有质量问题；如有侵权请联系我）

过程动图

Part 2： 拟实现功能描述

1. 本次拟实现基于三个条件进行检索：问题状态，问题种类，问题ID号三个条件检索
2. 当某个条件未输入任何条件，则该条件不作为检索条件
3. 当多个条件输入信息后，则需要同时满足多个条件，输出结果
   • 判断满足条件的问题，单独设置一个函数，对三个条件进行判断

数据库信息

Part 3：代码

Sub 查询问题1()
    Call delAllShape
    Set sht = ThisWorkbook.Worksheets("问题管理")
    problemStatus = sht.Range("H15")
    questionType = sht.Range("H16")
    uniqueId = sht.Range("H17")
    
    ' 获取行数
    maxRow = sht.Cells(Rows.Count, "Q").End(xlUp).Row
    
    For i = 3 To maxRow Step 1
        uniqueId_i = sht.Cells(i, "J").Value
        questionType_i = sht.Cells(i, "K").Value
        problemStatus_i = sht.Cells(i, "L").Value
        
        yn = checkCondition(uniqueId_i, questionType_i, problemStatus_i, uniqueId, questionType, problemStatus)
        
        If yn = True Then
            If questionType_i = "尺寸" Then
                shapeType = msoShapeOval
            Else
                shapeType = msoShapeRectangle
            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
            
            Set newShape = sht.Shapes.AddShape(shapeType, positionX, positionY, widthVal, heightVal)
            shapeName = newShape.Name
            Debug.Print (shapeName)
            
            sht.Cells(i, "Q").Value = 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
        End If
    Next i
End Sub

Function checkCondition(uniqueId_i, questionType_i, problemStatus_i, uniqueId, questionType, problemStatus)
    result = True
    
    ' 如果条件不为空，则判断与条件是否一致，任何一个条件不满足则不满足
    If uniqueId <> "" Then
        If uniqueId_i <> uniqueId Then
            result = False
        End If
    End If
    
    ' 如果条件不为空，则判断与条件是否一致
    If questionType <> "" Then
        If questionType_i <> questionType Then
            result = False
        End If
    End If
    
    ' 如果条件不为空，则判断与条件是否一致
    If problemStatus <> "" Then
        If problemStatus_i <> problemStatus Then
            result = False
        End If
    End If
    
    checkCondition = result

End Function

代码截图

Part 4：部分代码解读

1. 对于判读是否符合条件，先设置result变量为True
2. 当某个条件不为空的时候，判断是否符合条件，如果不符合则将result设置为False
3. 当最终返回的是False，则不将这个问题对应的图形画出来，反之则画出来

    result = True
    
    ' 如果条件不为空，则判断与条件是否一致，任何一个条件不满足则不满足
    If uniqueId <> "" Then
        If uniqueId_i <> uniqueId Then
            result = False
        End If
    End If

---

• 更多学习交流，可加小编微信号learningBin

---

更多精彩，请关注微信公众号
扫描二维码，关注本公众号