Excel VBA 遍历用户窗体控件识别空文本框及数据录入问题求解

代码问题分析 #

• service、Quantity、Cost三个数组的元素顺序和dept数组的科室顺序完全不匹配，遍历取值时对应不上目标科室的服务、数量、成本数据
• 赋值逻辑错误：直接把整个service/Quantity/Cost数组赋值给单个单元格，只会写入数组的第一个元素，无法写入对应科室的单条数据
• 存在拼写不一致问题：科室数组里的Phamacy4拼写错误（正确应为Pharmacy4），和控件名拼写不匹配会触发“找不到控件”的报错
• 提前把所有控件值存入数组的写法维护成本极高，后续新增科室需要同时修改4个数组的内容，很容易出现顺序不匹配的问题

修正后代码 #

Private Sub CommandButton1_Click()
    Dim dept, details, i As Long
    Dim zh As Worksheet, LastRow As Long
    Dim svcCtrl As Control, qtyCtrl As Control, costCtrl As Control
    
    Set zh = ThisWorkbook.Sheets("PublicDatabase")
    LastRow = zh.Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    ' 统一维护科室列表，已修正拼写错误
    dept = Array("Accomodation", "Consultation", "Haematology", _
        "Histopathology", "Nursingcare", "Others1", _
        "Others2", "Microbiology", "Reviews", "Radiology1", "Radiology2", "Radiology3", "Pharmacy1", _
        "Pharmacy2", "Pharmacy3", "Pharmacy4", "Pharmacy5", "Pharmacy6")
    
    details = PatientDetails()
       
    For i = 0 To UBound(dept)
        ' 读取当前科室对应的数量控件
        Set qtyCtrl = Me.Controls("Txt_Qty" & dept(i))
        If qtyCtrl.Value <> "" Then
            ' 自动匹配对应服务控件：优先找txt_前缀，找不到再找cmb_前缀
            On Error Resume Next
            Set svcCtrl = Me.Controls("txt_" & LCase(dept(i)))
            If Err.Number <> 0 Then
                Set svcCtrl = Me.Controls("cmb_" & LCase(dept(i)))
                Err.Clear
            End If
            On Error GoTo 0
            
            ' 读取对应成本控件
            Set costCtrl = Me.Controls("txt_Cost" & dept(i))
            
            ' 写入单行数据
            details(1, 1) = LastRow - 1
            zh.Cells(LastRow, 1).Resize(, 18) = details
            zh.Cells(LastRow, 19) = svcCtrl.Value ' 对应科室的服务项目
            zh.Cells(LastRow, 20) = qtyCtrl.Value ' 对应科室的录入数量
            zh.Cells(LastRow, 22) = costCtrl.Value ' 对应科室的成本数据
            LastRow = LastRow + 1
        End If
    Next
    MsgBox "Entered", vbInformation
End Sub

优化说明 #

• 去掉了提前声明的三个值数组，改为遍历到对应科室时动态读取控件值，彻底避免数组顺序不匹配的问题
• 新增服务控件自动识别逻辑，不用手动维护每个科室对应的服务控件类型是输入框还是下拉框
• 后续新增科室只需要在dept数组里添加对应名称即可，不用修改其他逻辑，维护成本大幅降低

内容的提问来源于stack exchange，提问作者Israel