Solving variable variable's names issue in excel

问题

I have a programming issue concerning variable variable's names

I need to make an questionaire in excel where answers to certain questions will either hide or unhide certain rows. I have no idea how to optimize it, although I searched for the solution for quite a while.

Code sample which performs an action on one question

Private Function RowNo(ByVal text1 As String) As Long
    Dim f As Range
    Set f = Columns(2).Find(text1, Lookat:=xlWhole)
    If Not f Is Nothing Then
        RowNo = f.Row
    Else
        RowNo = 0
    End If
End Function

Dim QAr As Variant            
Dim YtQ1Ar As Variant       
Dim YtQ1, rYtQ1 As Long     

QAr = Array("Q1")
YtQ1Ar = Array("1.2", "1.3", "1.4", "1.5", "1.6", "1.7", "1.7.1", "1.7.2", "1.7.23", "1.7.24", "1.8", "1.9", "1.10", "1.11", "1.12", "1.13")


    For Q = LBound(QAr) To UBound(QAr)

        For YtQ1 = LBound(YtQ1Ar) To UBound(YtQ1Ar)
            rYtQ1 = RowNo(YtQ1Ar(YtQ1))
                If rYtQ1 > 0 Then
                    Rows(rYtQ1).Hidden = (UCase(Cells(RowNo("1."), ColAn).Value) <> "TAK")
                Else
                    Debug.Print "'" & YtQ1Ar(YtQ1) & "' was not found!"
                End If
        Next YtQ1
    Next Q

Now, I want to perform similar actions on many different questions.

At first I wanted to create a similar arrays and variables with names Q1, YtQ1Ar; Q2, YtQ2Ar ... and so on, but I found out that it is impossible to use a variable variable's names in a loop in VBA.

Can you please help me with an idea how to solve that issue? Or do I have to rewrite the code for each question?

回答1:

There are several ways of creating 'lists' of variables. Three of the most common are:

Collections, exactly as MacroMan's code - take note of how he declares his variables (use a datatype for each declaration).
Multi-dimensional arrays, you can reference each of the indexes independently. This probably wouldn't suit you as the number of sub-questions might vary for each question but, nevertheless, a snippet of your code might be:
```
Dim questions(10, 20) As Variant 'where first dimension is question number and second is sub-question item.

questions(0,0)="1.1"
questions(0,1)="1.2"
' etc.
```
Array of Arrays, you can keep a one-dimensional array for each of your sub-question arrays. This might be more suitable to you, like so:
```
Dim questions(10) As Variant

questions(0) = Array("1.2", "1.3", "1.4", "1.5") 'etc.
questions(1) = Array("2.2", "2.4", "2.6") 'etc.
```

Having said that, your code is a touch inefficient because it runs the .Find routine in every iteration of your loop and it will throw an unhandled error if any of the sub-question items don't exist in line: Rows(rYtQ).Hidden = (UCase(Cells(RowNo("1."), ColAn).Value) <> "TAK").

Architecturally, you'd be far better to read all of the relevant rows into some kind of storage (say a Range or Collection) in one routine, and in a second routine, check each question to see if those rows need to be hidden. This will give you greater speed and much more flexibility (e.g. to toggle the hidden/unhidden whenever an answer is changed). Sorry it's such a lengthy answer, but it gives you an idea of how important a planned programme structure is.

In the code below, I've given you an example of this. I've used a Class object to make it more obvious (this might be a bit black belt VBA so you may want to ignore it, but it does make the point clearly). So...

First insert a Class Module (Insert ~> Class Module) and name it cQuestionFields. Then paste this code into it:

Option Explicit
Private mQuestionNumber As Integer
Private mAnswerCell As Range
Private mQuestionRange As Range
Private mUnHiddenKey As String
Private mHideUnhideRows As Range
Public Property Get QuestionNumber() As Integer
    QuestionNumber = mQuestionNumber
End Property
Public Function AnswerIsChanged(cell As Range) As Boolean
    AnswerIsChanged = Not Intersect(cell, mAnswerCell) Is Nothing
End Function
Public Sub HideOrUnhideRows()
    Dim answer As String

    answer = UCase(CStr(mAnswerCell.Value2))
    mHideUnhideRows.EntireRow.Hidden = (answer <> mUnHiddenKey)
End Sub
Public Function InitialiseQuestion(questionNum As Integer, _
                                   questionColumn As Range, _
                                   answerColumn As Range, _
                                   unhideKey As String) As Boolean
    Dim ws As Worksheet
    Dim thisQ As String
    Dim nextQ As String
    Dim startCell As Range
    Dim endCell As Range
    Dim offsetQtoA As Integer

    'Assign the question number
    mQuestionNumber = questionNum

    'Assign column offset between question and answer
    offsetQtoA = answerColumn.Cells(1).Column - _
                 questionColumn.Cells(1).Column

    'Convert question number to string format "n."
    thisQ = CStr(questionNum) & "."
    nextQ = CStr(questionNum + 1) & "."

    'Find cell of this question
    Set ws = questionColumn.Worksheet
    Set startCell = questionColumn.Cells.Find( _
                    What:=thisQ, _
                    After:=questionColumn.Cells(1), _
                    LookIn:=xlFormulas, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=True)

    'Check the question exists
    If startCell Is Nothing Then
        InitialiseQuestion = False
        Exit Function
    End If

    'Set the answer cell
    Set mAnswerCell = startCell.Offset(, offsetQtoA)

    'Find the last cell within this question range
    Set endCell = questionColumn.Cells.Find( _
                  What:=nextQ, _
                  After:=startCell, _
                  LookIn:=xlFormulas, _
                  LookAt:=xlWhole, _
                  SearchOrder:=xlRows, _
                  SearchDirection:=xlNext, _
                  MatchCase:=True)

    'If nothing is found, set end of column
    If endCell Is Nothing Then
        Set endCell = ws.Cells(ws.Rows.Count, questionColumn.Column).End(xlUp)
    Else
        Set endCell = endCell.Offset(-1)
    End If

    'Define the search range for this question
    Set mQuestionRange = ws.Range(startCell, endCell)

    'Assign the hiding key
    mUnHiddenKey = unhideKey

    InitialiseQuestion = True
End Function
Public Sub AssignTargetRows(ParamArray questions() As Variant)
    Dim questionItem As Variant
    Dim lastCell As Range
    Dim foundCell As Range

    'Find the relevant cells for each question item
    Set lastCell = mQuestionRange.Cells(1)
    For Each questionItem In questions
        Set foundCell = mQuestionRange.Cells.Find( _
                        What:=CStr(questionItem), _
                        After:=lastCell, _
                        LookIn:=xlFormulas, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=True)

        'If the question item exists, add it to our range
        If Not foundCell Is Nothing Then
            If mHideUnhideRows Is Nothing Then
                Set mHideUnhideRows = foundCell
            Else
                Set mHideUnhideRows = Union(mHideUnhideRows, foundCell)
            End If
            Set lastCell = foundCell
        End If
    Next
End Sub

Now in your module, paste the calling codes:

Option Explicit
Private mQuestionBank As Collection
Public Sub Main()
    Dim q As cQuestionFields

    'Assign all your values for each question
    PopulateQuestionBank

    'Loop through each question to test for hiding
    For Each q In mQuestionBank
        q.HideOrUnhideRows
    Next

End Sub
Public Sub ActIfAnswerChanged(Target As Range)
    Dim cell As Range
    Dim q As cQuestionFields

    ' Loop through cells in target to see if they are answer cells
    For Each cell In Target.Cells
        For Each q In mQuestionBank
            If q.AnswerIsChanged(cell) Then q.HideOrUnhideRows
        Next
    Next

End Sub

Public Sub PopulateQuestionBank()
    Dim ws As Worksheet
    Dim q As cQuestionFields
    Dim validQ As Boolean

    Set mQuestionBank = New Collection

    'Assign the worksheet holding the question.
    'You can change this whenever any of your question are on a different sheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")


    'Question 1: note change question and answer columns to yours.
    Set q = New cQuestionFields
    validQ = q.InitialiseQuestion(questionNum:=1, _
                                  questionColumn:=ws.Columns(2), _
                                  answerColumn:=ws.Columns(4), _
                                  unhideKey:="TAK")
    If validQ Then
        q.AssignTargetRows "1.2", "1.3", "1.4", "1.5", "1.6", "1.7", "1.7.1", "1.7.2", "1.7.23", "1.7.24", "1.8", "1.9", "1.10", "1.11", "1.12", "1.13"
        mQuestionBank.Add q, Key:=CStr(q.QuestionNumber)
    End If

    'Question 2
    Set q = New cQuestionFields
    validQ = q.InitialiseQuestion(questionNum:=2, _
                                  questionColumn:=ws.Columns(2), _
                                  answerColumn:=ws.Columns(4), _
                                  unhideKey:="TAK")
    If validQ Then
        q.AssignTargetRows "2.2", "2.3", "2.4", "2.5", "2.6"
        mQuestionBank.Add q, Key:=CStr(q.QuestionNumber)
    End If

    'Question 3
    Set q = New cQuestionFields
    validQ = q.InitialiseQuestion(questionNum:=3, _
                                  questionColumn:=ws.Columns(2), _
                                  answerColumn:=ws.Columns(4), _
                                  unhideKey:="TAK")
    If validQ Then
        q.AssignTargetRows "3.7", "3.7.3", "3.7.2", "3.7.23", "3.7.24"
        mQuestionBank.Add q, Key:=CStr(q.QuestionNumber)
    End If
End Sub

You'll see that I've added a routine called ActIfAnswerChanged. This is what I mean by added flexibility. If you post the following code in your Worksheet_Change event (double click your question sheet in your VBA editor and select this event), then it will run hide/unhide the rows whenever an answer is changed.

Private Sub Worksheet_Change(ByVal Target As Range)
    ActIfAnswerChanged Target
End Sub

回答2:

Try something like:

Dim QColl As Collection
Dim Q As Long
Dim YtQAr As Variant
Dim YtQ As Long, rYtQ As Long

Set QColl = New Collection

QColl.Add Array("1.2", "1.3", "1.4", "1.5"), Key:="Q1"
QColl.Add Array("2.2", "2.3"), Key:="Q2"

For Q = 1 To QColl.Count
    YtQAr = QColl.Item("Q" & Q)
    For YtQ = LBound(YtQAr) To UBound(YtQAr)
        rYtQ = RowNo(YtQAr(YtQ))
        If rYtQ > 0 Then
          Rows(rYtQ).Hidden = (UCase(Cells(RowNo("1."), ColAn).Value) <> "TAK")
        Else
            Debug.Print "'" & YtQAr(YtQ) & "' was not found!"
        End If
    Next YtQ
Next Q

来源：https://stackoverflow.com/questions/33334447/solving-variable-variables-names-issue-in-excel

标签

excel-vba

vba

excel