Question

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

我需要在excel中进行问卷调查，其中某些问题的答案会隐藏或取消隐藏某些行。我不知道如何优化它，虽然我已经搜索了一段时间的解决方案。

对一个问题执行操作的代码示例

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

现在，我想对许多不同的问题采取类似的行动。

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

你能帮我解释一下如何解决这个问题吗？或者我是否必须为每个问题重写代码？

Answer 1

有几种方法可以创建变量的“列表”。最常见的三个是：

Collections，与MacroMan's代码完全一样 - 注意他如何声明他的变量（为每个声明使用数据类型）。
Multi-dimensional arrays，您可以单独引用每个索引。这可能不适合您，因为每个问题的子问题数量可能会有所不同，但是，您的代码片段可能是：
```
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，您可以为每个子问题数组保留一维数组。这可能更适合你，如：

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例程，如果任何子问题项不存在，它将抛出未处理的错误：Rows(rYtQ).Hidden = (UCase(Cells(RowNo("1."), ColAn).Value) <> "TAK")。

在架构上，您可以在一个例程中将所有相关行读入某种存储（例如Range或Collection），并在第二个例程中检查每个问题是看是否需要隐藏这些行。这将为您提供更快的速度和更大的灵活性（例如，无论何时更改答案，都要切换隐藏/取消隐藏）。对不起，这是一个冗长的答案，但它让您了解计划的程序结构的重要性。

在下面的代码中，我给你举了一个例子。我已经使用了一个Class对象来使它更明显（这可能有点黑带 VBA，所以你可能想忽略它，但它确实清楚地说明了这一点）。所以......

首先插入Class Module（插入〜＆gt; 类模块）并将其命名为 cQuestionFields 。然后将此代码粘贴到其中：

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

现在在您的模块中，粘贴调用代码：

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编辑器中双击问题表并选择此事件），则每当答案更改时，它都会运行隐藏/取消隐藏行。

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

Answer 2

尝试类似：

    self.problist = ObjectListView(self, -1, style=wx.LC_REPORT|wx.SUNKEN_BORDER)
    self.problist.SetColumns([
            ColumnDefn("Problem", "left", 400, valueGetter="short_des"),
            ColumnDefn("First Treated", "left", 100, valueGetter="prob_date"),
            ColumnDefn("ICD-10 Code", "left", 100, valueGetter="icd10")
            ])
    self.problist.SetObjects(problems)
    self.problist.cellEditMode = ObjectListView.CELLEDIT_DOUBLECLICK
    self.problist.Bind(EVT_CELL_EDIT_STARTING, self.HandleCellEditStarting)
    self.problist.Bind(EVT_CELL_EDIT_FINISHED, self.HandleCellEditFinished)
    self.problist.rowFormatter = self.rowFormatter
    self.problist.useAlternateBackColors = False

在excel中解决变量变量的名称问题

2 个答案: