VBA学习(73)：Excel VBA 动态添加控件/学生成绩筛选

xwLink1996

已于 2024-09-02 10:50:42 修改

阅读量1k

点赞数 21

分类专栏： VBA学习文章标签： excel VBA

于 2024-09-02 10:49:23 首次发布

本文链接：https://blog.csdn.net/nianfen/article/details/141814079

版权

VBA学习专栏收录该内容

71 篇文章 15 订阅

订阅专栏

需求：筛选成绩与参考标准成绩相差在一定范围内的同学。比如标准成绩是100，成绩差是20，那么根据不同情况，成绩在100~120，或80~100，或80~120这些范围内的同学都应该被选到。

怎么来实现呢？

思考过程就不说了，直接动手吧：

1、插入一个Userform1，Name什么的就不改了

2、插入几个标签，一个命令按钮，LbSubject（科目）、LbStandard（标准）、LbDeviation（差值）、LbType（方式）、CmdConfirm（确定）：

3、在Userform1的代码块顶端定义几个变量：

Dim dynamicLabel As Control
Dim arrA(), arrB(), arrC(), arrDetail()
Dim iRow As Integer
Dim iWidth As Integer

4、Userform1的Activate事件代码：

Private Sub UserForm_activate()
    arrC = Array("正差", "负差", "正负差", "总差")

    iWidth = 50
    h = 5
    With Me.LbSubject
        .Left = 1
        .Top = 1
        .Width = iWidth
    End With
    With Me.LbStandard
        .Left = Me.LbSubject.Left
        .Top = Me.LbSubject.Top + Me.LbSubject.Height + h
        .Width = Me.LbSubject.Width
    End With
    With Me.LbDeviation
        .Left = Me.LbStandard.Left
        .Top = Me.LbStandard.Top + Me.LbStandard.Height + h
        .Width = Me.LbStandard.Width
    End With
    With Me.LbType
        .Left = Me.LbDeviation.Left
        .Top = Me.LbDeviation.Top + Me.LbDeviation.Height + h
        .Width = Me.LbDeviation.Width
    End With
    Sheet1.Activate
    With ActiveSheet
        iRow = .UsedRange.Rows.Count
        .Range("R4:AA" & iRow).ClearContents
        iName = .Range("I2")
        arrDetail = .Range("A7:J" & iRow).Value
        arrA = .Range("K1:O2").Value
        arrB = .Range("K4:O4").Value
        For i = 1 To 5
            Set dynamicLabel = Me.Controls.Add("Forms.Label.1", "dycLb_Subject" & i)
            With dynamicLabel
                .Caption = arrA(1, i)
                .Top = Me.LbSubject.Top
                .Height = Me.LbSubject.Height
                .Width = iWidth
                .Left = Me.LbSubject.Left + Me.LbStandard.Width + .Width * (i - 1)
                .FontSize = 10
                .FontName = "微软雅黑"
                .ForeColor = RGB(50, 50, 255)
                .TextAlign = 2
            End With
            Set dynamicLabel = Me.Controls.Add("Forms.Label.1", "dycLb_Standard" & i)
            With dynamicLabel
                .Caption = arrA(2, i)
                .Top = Me.LbStandard.Top
                .Height = Me.LbStandard.Height
                .Width = iWidth
                .Left = Me.LbStandard.Left + Me.LbStandard.Width + .Width * (i - 1)
                .FontSize = 10
                .FontName = "微软雅黑"
                .ForeColor = RGB(128, 128, 128)
                .TextAlign = 2
            End With
            Set dynamicLabel = Me.Controls.Add("Forms.TextBox.1", "dycTxb_" & i)
            With dynamicLabel
                .Text = arrB(1, i)
                .Top = Me.LbDeviation.Top
                .Height = Me.LbDeviation.Height
                .Width = iWidth
                .Left = Me.LbDeviation.Left + Me.LbDeviation.Width + .Width * (i - 1)
                .FontSize = 10
                .FontName = "微软雅黑"
                .ForeColor = vbRed   ' RGB(50, 50, 255)
                .TextAlign = 2
                If i = 5 Then
                    .BackColor = RGB(255, 204, 0)
                End If
            End With
            If i < 5 Then
                Set dynamicLabel = Me.Controls.Add("Forms.OptionButton.1", "dycOp_" & i)
                With dynamicLabel
                    .Caption = arrC(i - 1)
                    .Top = Me.LbType.Top
                    .Height = Me.LbType.Height
                    .Width = iWidth
                    .Left = Me.LbType.Left + Me.LbType.Width + .Width * (i - 1)
                    .FontSize = 10
                    .FontName = "微软雅黑"
                    .ForeColor = vbRed   ' RGB(50, 50, 255)
                    .Value = True
                    .TextAlign = 2
                End With
             End If
        Next
    End With
    Me.Height = Me.LbType.Top + Me.LbType.Height + 40
    Me.Width = Controls("dycLb_Subject5").Left + Controls("dycLb_Subject5").Width + 20
    Me.CmdConfirm.Top = Me.LbType.Top
    Me.CmdConfirm.Left = Me.Width - Me.CmdConfirm.Width - 20
End Sub

代码分析：

（1）以LbSubject为基准，调整其他标签的位置

（2）激活Sheet1，读入数据

（3）从1-5循环，动态添加控件，科目标签（语文~总分）、标准标签（各科分数）、差值文本框、方式选项按钮，并设置控件的各种属性。

（4）最后，调整UserForm1的大小，Height根据LbType.Top来调整，Width根据dycLb_Subject5来调整。

5、在Sheet1表添加命令按钮CmdQuery2（查询2），并输入代码：

Private Sub CmdQuery2_Click()
    UserForm1.Show
End Sub

6、我们点击查询2：

这里，差值可以修改，总分差值是单独的数字，跟前面的各科差没有关系。方式，根据查询需要点选，默认是总差。

7、CmdConfirm（确定）按钮代码：

Private Sub CmdConfirm_Click()
    Dim iType As String
    Dim arrSelected()
    '确定哪个选项被选中，取其Caption
    For i = 1 To 4
        If Controls("dycOp_" & i).Value = True Then
            iType = Controls("dycOp_" & i).Caption
        End If
    Next
    Sheet1.Activate
    With ActiveSheet
        If iType = "正差" Then
            k = 0: m = 0
            For i = 1 To UBound(arrDetail, 1)
                For j = 1 To 4
                    '正差，我们定义为：该同学成绩比标准成绩高，，幅度不超过差值
                    If Round(arrDetail(i, j + 5) - arrA(2, j), 2) > Round(Controls("dycTxb_" & j), 2) _
                        Or Round(arrDetail(i, j + 5) - arrA(2, j), 2) < 0 Then
                    Exit For
                    End If
                    If j = 4 Then
                        'Stop
                        k = k + 1
                        ReDim Preserve arrSelected(9, m)
                        For p = 0 To 9
                            arrSelected(p, m) = arrDetail(i, p + 1)
                        Next
                        m = m + 1
                    End If
                Next
            Next
            If k > 0 Then
                .Cells(4, 18).Resize(UBound(arrSelected, 2) + 1, 10) = Application.WorksheetFunction.Transpose(arrSelected)
            End If
        ElseIf iType = "负差" Then
            k = 0: m = 0
            For i = 1 To UBound(arrDetail, 1)
                For j = 1 To 4
                    '负差，我们定义为：该同学成绩比标准成绩低，，幅度不超过差值
                    If Round(arrA(2, j) - arrDetail(i, j + 5), 2) > Round(Controls("dycTxb_" & j), 2) _
                        Or Round(arrA(2, j) - arrDetail(i, j + 5), 2) < 0 Then
                    Exit For
                    End If
                    If j = 4 Then
                        'Stop
                        k = k + 1
                        ReDim Preserve arrSelected(9, m)
                        For p = 0 To 9
                            arrSelected(p, m) = arrDetail(i, p + 1)
                        Next
                        m = m + 1
                    End If
                Next
            Next
            If k > 0 Then
                .Cells(4, 18).Resize(UBound(arrSelected, 2) + 1, 10) = Application.WorksheetFunction.Transpose(arrSelected)
            End If
        ElseIf iType = "正负差" Then
             k = 0: m = 0
            For i = 1 To UBound(arrDetail, 1)
                For j = 1 To 4
                    '正负差，我们定义为：该同学成绩比标准成高或低，幅度不超过差值
                    If Abs(Round(arrDetail(i, j + 5) - arrA(2, j), 2)) > Round(Controls("dycTxb_" & j), 2) Then
                        Exit For
                    End If
                    If j = 4 Then
                        'Stop
                        k = k + 1
                        ReDim Preserve arrSelected(9, m)
                        For p = 0 To 9
                            arrSelected(p, m) = arrDetail(i, p + 1)
                        Next
                        m = m + 1
                    End If
                Next
            Next
            If k > 0 Then
                .Cells(4, 18).Resize(UBound(arrSelected, 2) + 1, 10) = Application.WorksheetFunction.Transpose(arrSelected)
            End If
        ElseIf iType = "总差" Then
            k = 0: m = 0
            For i = 1 To UBound(arrDetail, 1)
                If Round(Abs(arrA(2, 5) - arrDetail(i, 10)), 2) <= Round(Controls("dycTxb_5")) Then
                    'For p = 1 To 10
                    '.Cells(4 + m, 17 + p) = arrDetail(i, p)
                    'Next
                    k = k + 1
                    ReDim Preserve arrSelected(9, m)
                    For p = 0 To 9
                        arrSelected(p, m) = arrDetail(i, p + 1)
                    Next
                    m = m + 1
                End If
            Next
            If k > 0 Then
                .Cells(4, 18).Resize(UBound(arrSelected, 2) + 1, 10) = Application.WorksheetFunction.Transpose(arrSelected)
            End If
        Else
            MsgBox "查询比较方式未选择！"
            Exit Sub
        End If
        For i = 1 To 5
            .Cells(4, 10 + i) = Controls("dycTxb_" & i)
        Next
    End With
    MsgBox "查询完成！共【" & k & "】记录！"
    Erase arrSelected
    Unload Me
End Sub

代码分析：

（1）首先通过循环，确定哪个选项被选中

（2）根据选项的Caption分别进行处理

（3）正差，我们定义为同学的成绩比标准高，但幅度不超过差值，即差值>同学-标准>0，在代码中，我们是排除不符合条件的记录；如果最终找到一条符合条件的记录，我们把它存到arrSelected（）数组里，这里我们采用Redim preserve方法，动态扩展数组，不断地写入符合条件的记录，同时把记录数记入k，作为判断arrSelected是否有记录的依据，在程序结尾的MsgBox也引用到k。

（4）把arrSelected的记录写入到EXCEL表格，注意要作一个转置。

（5）其他方式选项类似。

（6）查询完成后，把差值再回写到Excel表中的对应单元格。因为我们可能进行了修改。这里差值的调整方式有2种，一种是在点查询2命令按钮前，在EXCEL表中的K4~O4单元格进行修改，另一种是在显示的用户窗体中修改。

（7）代码并不复杂，难点在于各种查询方式的条件判断比较费脑筋，纯粹是数学问题。

感谢你们的阅读和喜欢，我收藏了很多技术干货，可以共享给喜欢我文章的朋友们，如果你肯花时间沉下心去学习，它们一定能帮到你，干货内容：