解决Excel中变量变量的名称问题 [英] Solving variable variable's names issue in 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:
-
Collections
,与MacroMan的
代码完全相同-请注意他如何声明变量(对于每个声明使用数据类型). -
多维数组
,您可以独立引用每个索引.这可能不适合您,因为每个问题的子问题数量可能会有所不同,但是,您的代码片段可能是:
Collections
, exactly asMacroMan'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.
话虽如此,您的代码在触摸效率上是低下的,因为它在循环的每次迭代中都运行 .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屋!