简体   繁体   中英

Add IF Rules using user form in excel vba

I want to give user the ability to add some IF rules to the my code via user form and then runs the program. The rules are something like this:

If Xarray(i,j-1)= "X" and Xarray(i,j+1)= "Y" Then Xarray(i,j)= "Z" 

Where "X" , "Y" and "Z" are text boxes which are filled with the user, using the user form and there is "ADD Rule" button when user click on it the rule will be added to the code programmatically. Later I can extend the rules to more complicated rules. My question is how I can create such procedure for Excel VBA?

Thanks.

Here is an example:

we have a user form which has three Text-Boxes and one "Add Rule" button. I created this code sample:

Private Sub UserForm_Initialize()

    Dim LeftCell As String, RightCell As String, CenterCell As String
    Dim iRule As String

     UserForm1.Show
    LeftCell = txtLeft.Text
    CenterCell = txtCenter.Text
    RightCell = txtRight.Text

    iRule = "If " & "Xarr(I, J - 1) = " & LeftCell & " And" & " Xarr(I, J + 1) = " & RightCell & " Then" & Chr(10) & _
            " Xarr(I, J) = " & CenterCell & Chr(10) & _
            "End If"

    MsgBox iRule
End Sub

The problem is that how I can use iRule (which is a string) as an "IF Statement" in my main code.

I suggest using a 2D array of "rules". When the user adds a rule, information such as rule type (equality, inequality) and the parameters to be tested will be entered into the array. Finally, when the check is being made, you can use the parameters inside an if..then statement inside a loop to test all elements of the array. If the rules are all combined with the AND opearator, then you can set a boolean variable to false and exit the loop. If you need more detail, or a code example, please post some trial code that I can work on.

Edit with Code:

I made a class that you can use for this purpose:

Option Explicit

'Class Parameters
Dim pRules() As Variant 'note the variant data type
Dim pCountRules As Long

Private Sub class_initialize()
    pCountRules = 0
End Sub

Public Sub AddRule(Parameter As Variant, Condition As Variant)
'note the variant data types
    If TypeName(Parameter) <> TypeName(Condition) Then
        'one possible exception I can think of, handle this here
        Exit Sub
    End If
    If pCountRules = 0 Then
        pCountRules = 1
        ReDim pRules(1 To 2, 1 To 1)
        pRules(1, 1) = Parameter
        pRules(2, 1) = Condition
    Else
        pCountRules = pCountRules + 1
        ReDim Preserve pRules(1 To 2, 1 To pCountRules)
        pRules(1, pCountRules) = Parameter
        pRules(2, pCountRules) = Condition
    End If
End Sub

Public Sub ResetRules()
    Erase pRules
    pCountRules = 0
End Sub

Public Function CheckRules() As Boolean
Dim i As Integer
    If pCountRules = 0 Then
        CheckRules = True   'or false, depends on your logic
    Else
        CheckRules = True
        For i = 1 To pCountRules
            If pRules(1, i) <> pRules(2, i) Then
                CheckRules = False
                Exit For
            End If
        Next i
    End If
End Function

Private Sub Class_Terminate()
    Erase pRules
End Sub

Note the use of variant data type. I avoid this when I can, you need heavy exception handling. If your data type is determined, then you can change this and include proper validation. I tested the class as follows:

Option Explicit

Sub test()
Dim Rules As clsRules
Dim testarr(1 To 1, 1 To 3) As String
Dim testparam(1 To 3) As String
    testarr(1, 1) = "a"
    testarr(1, 2) = "b"
    testarr(1, 3) = "c"
    testparam(1) = "a"
    testparam(2) = "b"
    testparam(3) = "c"
    'values match
    Set Rules = New clsRules
    Rules.AddRule testarr(1, 1), testparam(1)
    Rules.AddRule testarr(1, 2), testparam(2)
    Rules.AddRule testarr(1, 3), testparam(3)
    'will print true
    Debug.Print Rules.CheckRules

    'change parameter so values do not match
    testparam(3) = "a"
    Rules.ResetRules
    Rules.AddRule testarr(1, 1), testparam(1)
    Rules.AddRule testarr(1, 2), testparam(2)
    Rules.AddRule testarr(1, 3), testparam(3)
    'will print false
    Debug.Print Rules.CheckRules

    'clean up
    Erase testarr
    Erase testparam
    Set Rules = Nothing
End Sub

I hope this is useful for you.

我能想到的一种方法是使用您的字符串(要执行的代码)在新模块中创建一个子例程,然后运行该子例程

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM