基于多个文本框值执行任务

我正在学习VBA。 两件事情：

1. 有没有什么比长的elseif命令更有效率（我正在试图find最低的文本框值）
2. 根据最低的文本框值，我的Excel工作表中将出现形状。 这工作，但只有当我改变NBInv文本框是有道理的。 但是，这不是我想要的程序。 我希望它不断监视每个文本框的值，并find最低的一个。

示例代码：

Private Sub NBInv_Change() If NBInv.Text = "0" Or NBInv.Text = "" Then ActiveSheet.Shapes("NFlow").Visible = False ElseIf NBInv.Value < NEBInv.Text And NBInv.Text < NEBInv.Text _ And NBInv.Text < EBInv.Text And NBInv.Text < SEBInv.Text _ And NBInv.Text < SBInv.Text And NBInv.Text < SWBInv.Text _ And NBInv.Text < WBInv.Text And NBInv.Text < NWBInv.Text Then ActiveSheet.Shapes("NFlow").Visible = True ActiveSheet.Shapes("FlowNFalse").Visible = False End If End Sub 

Answer 1

你可以简化代码中设置Visible属性。 Val（NBInv.Value）将为所有非数字值返回0，数字为0. CBool​​（）将0转换为False，将所有其他值转换为True。

 Private Sub Solution() Dim HasValue As Boolean HasValue = CBool(Val(NBInv.Value)) ActiveSheet.Shapes("NFlow").Visible = HasValue ActiveSheet.Shapes("FlowNFalse").Visible = Not HasValue End Sub 

以下函数将返回列出的所有控件中具有最小值的那个。

私有函数最小（）

 Dim Fun As Variant Dim Tmp As Variant Dim Inv() As String Dim i As Integer Inv = Split("NBInv NEBInv EBInv SEBInv SBInv SWBInv WBInv NWBInv") Fun = 10 ^ 6 For i = 0 To UBound(Inv) Tmp = Val(ActiveSheet.OLEObjects(Inv(i)).Object.Value) If Tmp < Fun Then Fun = Tmp Next i Smallest = Fun 

结束function

Funvariables的值必须设置为大于您在文本框中遇到的值。 我select了10 ^ 6。

Answer 2

 Function Min(ParamArray values() As Variant) Dim minValue, Value As Variant minVal = values(0) For Each Value In values If minVal > Value Then minVal = Value Next Min = minVal End Function 

您可以使用此代码来查找最小值。

 Private Sub NBInv_Change() If NBInv.Text = "0" Or NBInv.Text = "" Then ActiveSheet.Shapes("NFlow").Visible = False ElseIf Val(NBInv.Value) = Min(Val(txt1.value),Val(txt2.value),Val(txt3.value),Val(txt4.value)) Then ActiveSheet.Shapes("NFlow").Visible = True ActiveSheet.Shapes("FlowNFalse").Visible = False End If End Sub 

Answer 3

我会把下面的代码放在相关的工作表代码窗格中：

 Option Explicit Const tbNames As String = "NBInv NEBInv EBInv SEBInv SBInv SWBInv WBInv NWBInv" '<--| list all your relevant XBInv textboxes names Const shpXFlowNames As String = "NFlow NEFlow EFlow SEFlow SFlow SWFlow WFlow NWFlow" '<--| list all "XFlow" shapes names corresponding to each XBInv textboxe Const shpFlowXFalseNames As String = "FlowNFalse FlowNEFalse FlowEFalse FlowSEFalse FlowSFalse FlowSWFalse FlowWFalse FlowNWFalse" '<--| list all "FlowXFalse" shapes names corresponding to each XBInv textboxe Dim tbs As Variant, shpXFlows As Variant, shpFlowXFalses As Variant Sub CheckTB() Dim minVal As Long Dim iShp As Long Dim iTbMin As Long tbs = Split(tbNames) '<--| fill the array with textboxes names shpXFlows = Split(shpXFlowNames) '<--| fill the array with "XFlow" shapes names shpFlowXFalses = Split(shpFlowXFalseNames) '<--| fill the array with "FlowXFalse" shapes names minVal = GetMinVal(iTbMin) For iShp = 0 To UBound(shpXFlows) '<--| loop through shapes to hide all "XFlow"s and unhide all "FlowXFalse"s Shapes(shpXFlows(iShp)).Visible = False Shapes(shpFlowXFalses(iShp)).Visible = True Next Shapes(shpXFlows(iTbMin)).Visible = True '<--| unhide "XFlow" shape with minimum value Shapes(shpFlowXFalses(iTbMin)).Visible = False '<--| hide "FlowXFalse" shape with minimum value End Sub Function GetMinVal(iTbMin As Long) As Long Dim iTb As Long iTbMin = 0 '<--|initialize textbox index with minimum value to the first one GetMinVal = OLEObjects(tbs(iTbMin)).Object.Value '<--|initialize textbox with minimum value to the first one For iTb = 0 To UBound(tbs) If CLng(OLEObjects(tbs(iTb)).Object.Value) < GetMinVal Then GetMinVal = CLng(OLEObjects(tbs(iTb)).Object.Value) iTbMin = iTb End If Next End Function Private Sub EBInv_Change() CheckTB End Sub Private Sub NEBInv_Change() CheckTB End Sub Private Sub NBInv_Change() CheckTB End Sub Private Sub NWBInv_Change() CheckTB End Sub Private Sub SBInv_Change() CheckTB End Sub Private Sub SEBInv_Change() CheckTB End Sub Private Sub SWBInv_Change() CheckTB End Sub Private Sub WBInv_Change() CheckTB End Sub