Excel VBA-使用VBIDE.CodeModule创建动态变量名称会关闭用户窗体,并且不会重新加载吗?

时间:2018-07-08 22:40:03

标签: vba excel-vba excel

成功使用此代码创建了一系列动态构造的变量名。确实工作得很好,但不幸的是,除非以某种方式加载了用户表单(但需要以无模式方式打开它,以便用户也可以访问工作表),否则它会关闭调用用户表单,并且在实际重新加载表单时没有多少重新加载表单的作用。

尝试隐藏并卸载表单,然后以无模式方式重新加载它,但不会重新加载。

Excel VBA: Dynamic Variable Name

Option Explicit

Private Const SourceQueryString As String = "myValue1=Dave&someOtherValue=Hockey&HockeyDate=Yesterday"


Sub Test()

Dim queryStringVariablesComponent As VBIDE.vbComponent
Dim queryStringVariablesModule As VBIDE.CodeModule
Dim codeText As String
Dim lineNum As Long: lineNum = 1
Dim lineCount As Long

Set queryStringVariablesComponent = ThisWorkbook.VBProject.VBComponents("QueryStringVariables")
Set queryStringVariablesModule = queryStringVariablesComponent.CodeModule
queryStringVariablesModule.DeleteLines 1, queryStringVariablesModule.CountOfLines

Dim parts
parts = Split(SourceQueryString, "&")

Dim part, variableName, variableValue
For Each part In parts
    variableName = Split(part, "=")(0)
    variableValue = Split(part, "=")(1)

    codeText = "Public Property Get " & variableName & "() As String"
    queryStringVariablesModule.InsertLines lineNum, codeText
    lineNum = lineNum + 1

    codeText = variableName & " = """ & variableValue & ""
    queryStringVariablesModule.InsertLines lineNum, codeText
    lineNum = lineNum + 1

    codeText = "End Property"
    queryStringVariablesModule.InsertLines lineNum, codeText
    lineNum = lineNum + 1

Next

DisplayIt
End Sub

Sub DisplayIt()
    MsgBox myValue1 'Should output "Dave"
End Sub
  

第2行-列标题字段根据用于构造变量名称的用户选择的标题而有所不同

enter image description here

  

最终解决方案

enter image description here


更新后的最终解决方案

  

将名称(而不是工作簿)设置为工作表(sheet(“ H”)),以便可以将其引用以进行删除。

enter image description here

名称创建

For Each HeaderCell In HeaderRange

    HeaderName = Replace(HeaderCell.value, " ", "_")
    ThisWorkbook.Worksheets("H").Names.Add Name:=HeaderName, RefersTo:=HeaderCell

Next

姓名删除

For Each nName In Names

    If nName.Parent.Name = "H" Then nName.Delete

Next nName

名称范围引用

  

仅有一点烦恼是因为名称的作用域是工作表而不是工作簿,所以只要使用范围,就必须包括对工作表的引用-Range(“ H!A_TEAM”)。

     

但是,将名称限定在专用工作表上是我看到的唯一可以删除它们而不删除所有其他永久性名称范围的方法。

Range("H!A_TEAM").Column

2 个答案:

答案 0 :(得分:1)

今晚晚些时候,我将解决OP的问题,该问题似乎是“如何在运行时创建无模式用户窗体”。现在,我想消除关于使用字典返回单元格引用与使用Range()Cells()返回引用的误解。

OP评论

  

就像我说的那样,除了在工作表范围级别而不是集合级别之外,我一直在做什么。只是不够干净和高效。当您可以直接直接前往已知地址时,为什么要到处检查房子?

单元格和范围对象存储对VBA集合中单元格的引用,可以通过它们的单元格地址来查找它们。字典还可以存储对单元格对象的引用的集合,可以通过其单元格地址来查找它们。

因此,如果单元格,范围,VBA集合和字典都是最快的集合?以下是使用以下代码对1000个单元进行1000次查找的结果:

enter image description here

请注意,Dictionary是迄今为止最快的,其次是VBA集合,其次是Cells和Range对象。那怎么可能呢?从表面上看,这似乎是违反直觉的,但是如果您考虑一下,您会意识到“单元格”集合和“范围”是工作表(17,179,869,184)单元格上所有单元格的横截面。 Cells集合非常简单,因为其中的所有单元格都是同一单元格块的一部分。单元格只解析父级,创建一个新的单元格集合并返回引用。 Range的范围要复杂得多,因为它支持多个区域,我相信这就是为什么它执行速度要慢得多的原因。字典和VBA集合都没有那么复杂。您给他们一个地址,他们就会直接转到存储的单元格引用。他们不必四处检查邻居,看看他们是否将被包括在集体聚会中。

像元,像元和范围定义

MSDN - Cell Objec

  

表示单个表单元格。 Cell对象是Cells集合的成员。 Cells集合表示指定对象中的所有单元格。

MSDN - Cells Collection Object

  

使用Cells属性返回Cells集合。

MSDN - Range Object (Excel)

  

代表一个单元格,一行,一列,包含一个或多个连续单元格块或3-D范围的单元格选择。

Option Explicit

'
' COPYRIGHT ? DECISION MODELS LIMITED 2006. All rights reserved
' May be redistributed for free but
' may not be sold without the author's explicit permission.
'
Private Declare Function getFrequency Lib "kernel32" Alias _
                                      "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare Function getTickCount Lib "kernel32" Alias _
                                      "QueryPerformanceCounter" (cyTickCount As Currency) As Long

Private Const sCPURegKey = "HARDWARE\DESCRIPTION\System\CentralProcessor\0"
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

Public Enum ReturnTypes
    retDictionaryTime
    retVBACollection
    retCellsRefTime
    retRangeRefTime
End Enum

Function MicroTimer() As Double
'
' returns seconds
'
    Dim cyTicks1 As Currency
    Static cyFrequency As Currency
    '
    MicroTimer = 0
    If cyFrequency = 0 Then getFrequency cyFrequency  ' get ticks/sec
    getTickCount cyTicks1                             ' get ticks
    If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency    ' calc seconds

End Function

Sub RangeLookupTimer(ReturnType As ReturnTypes)
    Const CELL_COUNT As Long = 1000
    Dim cell As Range
    Dim n As Long, repeats As Long, Result1 As Double, TimeOf As Double
    Dim dic As Object
    TimeOf = MicroTimer

    If ReturnType = retDictionaryTime Then
        Set dic = CreateObject("Scripting.Dictionary")
        For Each cell In Sheet1.Range("A1").Resize(CELL_COUNT)
            Set dic(cell.Address(0, 0)) = cell
        Next
        For repeats = 1 To 1000
            For n = 1 To CELL_COUNT
                Call TypeName(dic("A" & n))
            Next
        Next
    ElseIf ReturnType = retCellsRefTime Then
        For repeats = 1 To 1000
            For n = 1 To CELL_COUNT
                Call TypeName(Sheet1.Cells(n, "A"))
            Next
        Next
    ElseIf ReturnType = retRangeRefTime Then
        For repeats = 1 To 1000
            For n = 1 To CELL_COUNT
                Call TypeName(Sheet1.Range("A" & n))
            Next
        Next
    ElseIf ReturnType = retVBACollection Then
        Dim colCells As New Collection
        For Each cell In Sheet1.Range("A1").Resize(CELL_COUNT)
            colCells.Add Item:=cell, Key:=cell.Address(0, 0)
        Next
        For repeats = 1 To 1000
            For n = 1 To CELL_COUNT
                Call TypeName(colCells("A" & n))
            Next
        Next
    End If

    Result1 = MicroTimer - TimeOf
    Debug.Print Round(Result1, 2)
End Sub

答案 1 :(得分:1)

如何在修改模块代码后以无模式重新打开用户表单。

您遇到的问题源于使用用户窗体的默认实例。最好编写一个子例程(“ Sub ShowUserform()”来创建Userform的实例。

 Sub ShowUserform()
      Dim MyUserForm1 As New UserForm1
      UserForm1.Show False
  End Sub

在更新QueryStringVariables模块的最后一行代码中添加↓代码↓将在1秒钟后重新显示无格式用户窗体。

 Application.OnTime Now + TimeSerial(0, 0, 1), "ShowUserform"

或者,您可以Unload默认实例,然后再次显示它。

Unload UserForm1
UserForm1.Show