解决Excel中变量变量的名称问题 [英] Solving variable variable's names issue in excel

查看：140
本文介绍了解决Excel中变量变量的名称问题的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

我有一个关于变量变量名称的编程问题

I have a programming issue concerning variable variable's names

我需要在excel中制作一个问卷调查器，其中对某些问题的答案将隐藏或取消隐藏某些行.尽管我已经搜索了很长时间了，但是我不知道如何优化它.

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.

起初我想创建一个名称相似的数组和变量Q1，YtQ1Ar；Q2，YtQ2Ar...依此类推，但我发现在VBA的循环中不可能使用变量变量的名称.

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?

推荐答案

有几种创建变量列表"的方法.最常见的三个是:

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

  1. Collections ，与 MacroMan的代码完全相同-请注意他如何声明变量(对于每个声明使用数据类型).

  2. 多维数组，您可以独立引用每个索引.这可能不适合您，因为每个问题的子问题数量可能会有所不同，但是，您的代码片段可能是:

  1. Collections, exactly as MacroMan's code - take note of how he declares his variables (use a datatype for each declaration).

  2. 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.

    • 话虽如此，您的代码在触摸效率上是低下的，因为它在循环的每次迭代中都运行 .Find 例程，如果任何子问题项不执行，它将引发未处理的错误.t在以下行中存在: Rows(rYtQ).Hidden =(UCase(Cells(RowNo("1.")，ColAn).Value)<>"TAK").

    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").

    在架构上，最好将所有相关行读入某种例程(例如 Range 或 Collection )中的某种类型的存储中，第二个例程，检查每个问题以查看是否需要隐藏这些行.这将为您提供更快的速度和更大的灵活性(例如，每当更改答案时切换隐藏/不隐藏).抱歉，答案太长了，但是它使您了解计划的程序结构的重要性.

    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.

    在下面的代码中，我给了您一个例子.我使用了 Class 对象使其更明显(这可能有点 black belt VBA，因此您可能想忽略它，但确实可以清楚地说明要点).所以...

    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...

    首先插入一个 Class Module (插入〜> Class Module )，并将其命名为 cQuestionFields .然后将此代码粘贴到其中:

    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

    您会看到我添加了一个名为 ActIfAnswerChanged 的例程.这就是我所说的增加灵活性.如果您在 Worksheet_Change 事件中发布以下代码(在VBA编辑器中双击您的问题表并选择此事件)，则每当更改答案时，它将隐藏/取消隐藏行.

    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

    这篇关于解决Excel中变量变量的名称问题的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！

    查看全文
    相关文章
    其他开发最新文章
    热门教程
    热门工具
    登录 关闭
    扫码关注1秒登录
    发送“验证码”获取 | 15天全站免登陆