ExcelVba:循环使用用户表单控件来计数和识别空文本框

Question

@cdp1802这就是我尝试的哪个出错了

我添加了其他dept，并试图查看将其他控件的值存储在数组中的可能性。。。。显然不是的最佳方式

主要是用户需要在指定数量之前输入服务，然后有一个代码已经将服务费率与指定数量相乘但在其他方面，要在数据库中捕捉到这一点。。。基于每个"；Txt_ Qty"；进入Txt_qtyAccomodation。。。具有用于服务条目的文本框，该文本框被命名为"；txt_调节"；Txt_qty血液学。。。具有用于服务条目的文本框，该文本框被命名为"；cmb_血液学"；等等

此外，我还需要获取数量和成本……

专用子命令按钮1_Click()

Dim dept, details, service, Quantity, Cost, i As Long
Dim zh As Worksheet, LastRow As Long
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", "Phamacy4", "Pharmacy5", "Pharmacy6")

service = Array(Me.txt_initialconsultation.Value, Me.txt_Review.Value, Me.txt_nursingCare.Value, _
Me.txt_Accomodation.Value, Me.cmb_haematology.Value, Me.cmb_histopathology.Value, Me.cmb_Microbiology, _
Me.cmb_Other1.Value, Me.cmb_other2.Value, Me.Cmb_Radiology1.Value, Me.Cmb_Radiology2.Value, _
Me.Cmb_radiology3.Value, Me.Cmb_Pharmacy1.Value, Me.Cmb_Pharmacy2.Value, Me.Cmb_Pharmacy3.Value, _
Me.Cmb_Pharmacy4.Value, Me.Cmb_Pharmacy5.Value, Me.Cmb_Pharmacy6.Value)
Quantity = Array(Me.txt_QtyAccomodation.Value, Me.txt_QtyConsultation.Value, Me.txt_QtyHaematology.Value, _
Me.txt_QtyHistopathology.Value, Me.txt_QtyMicrobiology.Value, Me.txt_QtyNursingcare.Value, Me.txt_QtyOthers1.Value, _
Me.txt_QtyOthers2.Value, Me.txt_QtyPhamacy4.Value, Me.txt_QtyPharmacy1.Value, Me.txt_QtyPharmacy2.Value, Me.txt_QtyPharmacy3.Value, _
Me.txt_QtyPharmacy5.Value, Me.txt_QtyPharmacy6.Value, Me.txt_QtyRadiology1.Value, Me.txt_QtyRadiology2.Value, Me.txt_QtyRadiology3, _
Me.txt_QtyReviews.Value)
Cost = Array(Me.txt_costAccomodation.Value, Me.txt_CostCOnsultation.Value, Me.txt_CostHaematology.Value, _
Me.txt_CostHistopathology.Value, Me.txt_CostMicrobiology.Value, Me.txt_CostOthers1.Value, _
Me.txt_CostNursingCare.Value, Me.txt_CostOthers2.Value, Me.txt_CostPharmacy1.Value, Me.txt_CostPharmacy2.Value, _
Me.txt_CostPharmacy3.Value, Me.txt_CostPharmacy4.Value, Me.txt_CostPharmacy5.Value, Me.txt_CostPharmacy6.Value, _
Me.txt_CostRadiology1.Value, Me.txt_CostRadiology2.Value, Me.txt_CostRadiology3.Value)

details = PatientDetails()

Dim ccont As Control
For i = 0 To UBound(dept)
Set ccont = Me.Controls("Txt_Qty" & dept(i))
If ccont.Value <> "" Then

details(1, 1) = LastRow - 1
zh.Cells(LastRow, 1).Resize(, 18) = details
zh.Cells(LastRow, 19) = service
zh.Cells(LastRow, 20) = Quantity
zh.Cells(LastRow, 22) = Cost
LastRow = LastRow + 1
End If
Next
MsgBox "Entered", vbInformation

结束子

Answer 1

循环遍历一个文本框名称数组，检查非空值。

更新1-增加了服务和成本

Option Explicit
Private Sub CommandButton1_Click()
Dim dept, details, i As Long
Dim zh As Worksheet, LastRow As Long

Set zh = ThisWorkbook.Sheets("PublicDatabase")
LastRow = zh.Cells(Rows.Count, "A").End(xlUp).Row + 1
dept = Array("Accomodation", "Consultation", "Nursingcare", _
"Reviews", "Haematology", "Histopathology", _
"Others1", "Others2", "Microbiology", _
"Radiology1", "Radiology2", "Radiology3", _
"Pharmacy1", "Pharmacy2", "Pharmacy3", _
"Pharmacy4", "Pharmacy5", "Pharmacy6")

details = PatientDetails()

Dim qty As Control, cost As Control, service As Control
For i = 0 To UBound(dept)
Set qty = Me.Controls("Txt_Qty" & dept(i))
Set cost = Me.Controls("Txt_Cost" & dept(i))
Select Case Left(dept(i), 4)
Case "Acco", "Cons", "Nurs", "Revi"
Set service = Me.Controls("Txt_" & dept(i))
Case Else
Set service = Me.Controls("Cmb_" & dept(i))
End Select
If qty.Value <> "" Then
details(1, 1) = LastRow - 1
zh.Cells(LastRow, 1).Resize(, 18) = details
zh.Cells(LastRow, 19) = service.Value
zh.Cells(LastRow, 20) = qty.Value
zh.Cells(LastRow, 22) = cost.Value
LastRow = LastRow + 1
End If
Next
MsgBox "Entered", vbInformation
End Sub
Private Function PatientDetails() As Variant
Dim ar(1 To 1, 1 To 18)
With PubDefense
ar(1, 1) = 0
ar(1, 2) = "DEFENCE HEALTH MAINTENANCE LTD (PUBLIC)"
ar(1, 3) = .Txt_NameOfpDEFENSE.Value
ar(1, 4) = "Nil"
ar(1, 5) = .Txt_RefferrinProviderDefense.Value
ar(1, 6) = .Txt_NHISNoDefense.Value
ar(1, 7) = .Txt_AuthorizCodeDefense.Value
ar(1, 8) = .Txt_HmoCodeDefense.Value
ar(1, 9) = .Txt_DateOftreatmentDefense.Value
ar(1, 10) = .Txt_DateOFadmDefense.Value
ar(1, 11) = .Txt_DateOFdisDefense.Value
ar(1, 12) = "Nil"
ar(1, 13) = "Nil"
ar(1, 14) = "Nil"
ar(1, 15) = "Nil"
ar(1, 16) = "Nil"
ar(1, 17) = .Txt_DiagnosisDefense.Value
ar(1, 18) = .Txt_PatAddressDEfense.Value
End With
PatientDetails = ar
End Function