Excel使用VBIDE.CodeModule创建动态变量名，关闭用户表单，不会重新加载？

Question

成功使用此代码创建动态构造的变量名的范围。工作得很好，但不幸的是，它关闭了调用的userform，除非userform是通过模式加载的(但它需要非模型地打开，这样用户也可以访问工作表)，而且重新加载表单的数量在实际重新加载表单时是不起作用的。

已经尝试隐藏和卸载表单，然后重新加载它的模型，但它没有重新加载。

Excel VBA:动态变量名

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列标题字段，根据用于构造变量名称的用户选择的标头而不同。

​

​

最终解

​

​

更新的最终解决方案

限定工作表的名称(工作表(“H”)，而不是工作簿)，以便可以引用它们以供删除。

​

​

名称创建

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

名称范围引用

唯一轻微的麻烦是因为名称的作用域是工作表而不是工作簿，因此在使用范围时必须包括对工作表的引用-范围(“H！A_TEAM”)。 但是，将名称的范围限定到专用的工作表是唯一的方法，我可以看到识别它们以供删除，而不删除其他名称是永久的所有名称范围。

Range("H!A_TEAM").Column

Answer 1

如何在修改模块代码后重新打开Userform作为无模型。

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

子ShowUserform() Dim MyUserForm1作为新的UserForm1用户Form1显示假结束子

在更新QueryStringVariables模块的最后一行代码中添加↓这个代码↓，1秒后将重新显示Userform。

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

或者，在再次显示默认实例之前，可以先对其进行Unload。

卸载UserForm1用户表单1.显示

Answer 2

今晚晚些时候，我将讨论OP的问题，这个问题似乎是“如何在运行时创建无模型用户表单”。现在，我想澄清使用字典返回单元格引用的误解，而不是使用Range()或Cells()返回引用。

OP评论

正如我所说的，这是我一直在做的事情，除了在工作表的范围级别，而不是收集级别。只是不够干净和效率而已。当你可以直接到一个已知的地址直接去的时候，你为什么要到处跑，挨家挨户地检查呢？

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

那么，如果单元格、范围、VBA集合和字典都是集合，哪个是最快的？下面是使用以下代码查找1000个单元格1000次的结果：

​

​

注意，字典是速度最快的，其次是VBA集合，其次是单元格，最后是Range对象。这怎么可能呢？从表面上看，这似乎有违直觉，但如果你仔细想想，你会发现单元格集合和范围是工作表(17,179,869,184)单元格的所有单元格的横截面。单元格集合相当简单，因为其中的所有单元格都是同一单元格块的一部分。单元格只解析父单元格，创建一个新的单元格集合并返回引用。范围要复杂得多，因为它支持多个领域，我相信这就是为什么它的表现要慢得多。字典和VBA集合都不那么复杂。你给他们一个地址，他们直接进入存储的单元格引用。他们不需要到处查看邻居，看看他们是否会被纳入街区党。

单元格、单元格和范围定义

MSDN -细胞Objec

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

MSDN -单元收集对象

使用单元格属性返回单元格集合。

MSDN -范围对象(Excel)

表示一个单元格、一行、列、包含一个或多个连续单元格块的单元格的选择，或一个三维范围。

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