在 VBA 中动态创建动态数组

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/18978839/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-11 23:28:47  来源:igfitidea点击:

Dynamically Create Dynamic Arrays in VBA

excelvbaexcel-vba

提问by steinbitur

My objective is to use an array of names to create dynamic variables in VBA, heres the code:

我的目标是使用名称数组在 VBA 中创建动态变量,代码如下:

Sub mymacro()
Dim names()
names = Array("cat_code()", "dog_code()", "eagle_code()")
For Each c In names
Dim c As Integer
Next
end sub

And of course my real name array has hundreds of animals so it would be rather boring doing Dimfor each and every one of them. The error I'm getting is Compile Error: Duplicate declaration in current scope

当然,我的真名数组有数百只动物,所以Dim对它们中的每一个都做起来会很无聊。我得到的错误是Compile Error: Duplicate declaration in current scope

What is the best feasible solution to my objective?

我的目标的最佳可行解决方案是什么?

回答by

The compile error you are getting is caused by a duplicate declaration in the current scope.

您得到的编译错误是由当前范围内的重复声明引起的。

In other words: this means you are declaring more than one variable with the same name.

换句话说:这意味着您要声明多个同名变量。

Adding an Option Explicitstatement on top of you modules requires you to declare each variable you use. It's very helpful when you receive this error because you can quickly scan your code for duplicate declaration of the highlighted line Dim <variable_name>

Option Explicit你的模块之上添加一条语句需要你声明你使用的每个变量。当您收到此错误时,这非常有帮助,因为您可以快速扫描代码以查找突出显示行的重复声明Dim <variable_name>

This is a sample demonstrating why you are getting the error:

这是一个示例,演示了您收到错误的原因:

Option Explicit

Sub Main()

    Dim c As Worksheet
    For Each c In Sheets
        Dim c As Long   ' you are going to get an error in here because
                        ' a variable named: c, is already declared within the sub
                        ' you can't have two variables named: c.
        For c = 1 To ws.Range("A" & Rows.Count).End(xlUp).Row
            ' some code
        Next c
    Next

End Sub


There is no easy work around your problem. We would have been able to provide a better solution to your problem if you better explain what you are trying to achieve.

没有简单的方法可以解决您的问题。如果您能更好地解释您要实现的目标,我们本可以为您的问题提供更好的解决方案。

There is a workaround to achieve what you want but I wouldn't recommend doing it this way if you are unsure of you are actually doing ;). The below code will create a new module in your current VBA project. While iterating over the array with the animal names it will be writing new lines to Module2so after the execution your module two will be

有一种解决方法可以实现您想要的功能,但如果您不确定自己是否真的在做,我不建议您这样做 ;)。以下代码将在您当前的 VBA 项目中创建一个新模块。在使用动物名称迭代数组时,它将写入新行,Module2因此在执行后,您的模块二将是

enter image description here

在此处输入图片说明

In order for this code to work you have to add references to Microsoft Visual Basic for Applications Extensibility 5.3". You can do that by selectingTools>>References` in the VBE window.

为了使此代码工作,您必须在 VBE 窗口中添加对Microsoft Visual Basic for Applications Extensibility 5.3". You can do that by selectingTools >>References` 的引用。

Also, this requires you to Trust Access to VBA Project Object Model. Go to Excel Settings >> Trust Centre >> Macros >> tick Trust Access To VBA Project Object Model.

此外,这要求您Trust Access to VBA Project Object Model. 转到 Excel 设置 >> 信任中心 >> 宏 >> 勾选对 VBA 项目对象模型的信任访问。

enter image description here

在此处输入图片说明

Run the sample code.

运行示例代码。

Option Explicit

' this VBA project requires
' 1 - references to Microsoft Visual Basic For Applications Extensibility 5.3
'     add it via Tools > References
'
' 2 - trust access to VBA project object model
'     In spreadsheet view go to Excel(application options) >> Trust Centre >> Macro Settings
'     tick the Trust Access to VBA project object model

Sub mymacro()
    Dim names
    names = Array("cat_code", "dog_code", "eagle_code")
    Dim c As Variant
    AddAModule
    For Each c In names
        ' dynamically create arrays
        WriteToModule CStr(c)
    Next
    CloseModule
End Sub


Private Sub AddAModule()
    Dim VBProj As VBIDE.VBProject
    Dim VBComp As VBIDE.vbComponent
    Dim CodeMod As VBIDE.CodeModule

    Set VBProj = ThisWorkbook.VBProject
    Set VBComp = VBProj.VBComponents.Add(vbext_ct_StdModule)
    Set CodeMod = VBComp.CodeModule

    With CodeMod
        .DeleteLines 1, .CountOfLines
        .InsertLines 1, "Public Sub DynamicallyCreatedArrays()"
        .InsertLines 2, "    ' code for the sub"
    End With
End Sub

Private Sub WriteToModule(arrayName As String)
    With ActiveWorkbook.VBProject.VBComponents("Module2").CodeModule
        .InsertLines .CountOfLines + 2, "    Dim " & arrayName & " as Variant"
    End With
End Sub

Private Sub CloseModule()
    With ActiveWorkbook.VBProject.VBComponents("Module2").CodeModule
        .InsertLines .CountOfLines + 2, "End Sub"
    End With
End Sub

回答by Mike Woodhouse

VBA can't really do what you're trying to do without getting into a horrible world of complications.

VBA 不能真正做你想做的事情,而不会进入一个可怕的复杂世界。

How about using a VBA Collectionobject instead? You'll need to create a simple class to hold the number, because VBA collections work with references, not values.

改用 VBACollection对象怎么样?您需要创建一个简单的类来保存数字,因为 VBA 集合使用的是引用,而不是值。

So I created a Class and set its name to "AnimalCounter", with this content:

所以我创建了一个类并将其名称设置为“ AnimalCounter”,内容如下:

Public Counter As Integer

Then your macro becomes something like this:

然后你的宏变成这样:

Sub mymacro()

Dim coll As New Collection
Dim c As Variant
Dim ac As AnimalCounter

    For Each c In Array("cat", "dog", "eagle")
        Set ac = New AnimalCounter
        coll.Add ac, c
    Next

    Debug.Print coll("cat").Counter ' what's in "cat"?
    coll("dog").Counter = coll("dog").Counter + 1 ' update "dog" by one
    Debug.Print coll("dog").Counter ' "dog" should now be one more

End Sub

If you wanted arrays, put an array in to the class. Or another Collection, maybe?

如果需要数组,请将数组放入类中。或者另一个Collection,也许?

回答by Joshua Honig

Mike Woodhouse has the right idea of using a Collectionwith the keys of the animals. I add two notes:

迈克·伍德豪斯 (Mike Woodhouse) 有正确的想法,将 aCollection与动物的钥匙一起使用。我添加两个注释:

First, I would recommend using a Dictionaryinstead. It is faster than a Collection, and allows explicit access to the Keysand Itemscollections. With a Collection, there is actually no way to fetch the keys, since the basic purpose is an ordered listof items rather than a order-agnostic hash as with a Dictionary.

首先,我建议使用 aDictionary代替。它比 a 快Collection,并且允许显式访问KeysItems集合。使用 a Collection,实际上无法获取键,因为基本目的是项目的有序列表,而不是与 a 的顺序无关的散列Dictionary

For early-bound use of the Dictionarytype, add a reference to Microsoft Scripting Runtime.

对于该Dictionary类型的早期使用,请添加对 Microsoft Scripting Runtime 的引用。

Second, do not use an array for the individual animals!. The reason is because arrays in VBA use by-value semantics ( see Collections in VBA – Overview, Values and References in VBA, Array Assignment Rulesfor more information). In short, every time you fetch an instance of an array from the containing Collectionor Dictionary, you will be getting a new copyof the entire array. Thus any changes you make to the content of that array will not affect the actual array in the Dictionaryor Collection. To get around this, use a Collectioninstead. This will use by-reference semantics and makes it much easier to append new items.

其次,不要为单个动物使用数组!. 原因是因为 VBA 中的数组使用按值语义(有关更多信息,请参阅VBA 中的集合 – 概述VBA 中的值和引用数组分配规则)。简而言之,每次从包含的Collectionor 中获取数组的实例时Dictionary,您都会获得整个数组的新副本。因此,您对该数组内容所做的任何更改都不会影响Dictionaryor 中的实际数组Collection。要解决此问题,请改用 a Collection。这将使用按引用语义,并使附加新项目变得更加容易。

So here's what you'd want to do:

所以这就是你想要做的:

Sub ReadCodes() 
    Dim ws As Worksheet
    Dim strAnimalName  As String
    Dim dctAnimalCodes As New Dictionary
    Dim colAnimalCodes As Collection
    Dim lngAnimalCode  As Long 

    Set ws = Worksheets("Animal Code Data")
    For iRow = 1 To ws.UsedRange.Rows.Count
        strAnimalName = ws.Cells(iRow, 1)
        lngAnimalCode = ws.Cells(iRow, 2)

        ' Easy to check if key exists
        If Not dctAnimalCodes.Exists(strAnimalName) Then
            Set dctAnimalCodes(strAnimalName) = New Collection
        End If

        ' Getting the collection for this animal
        Set colAnimalCodes = dctAnimalCodes(strAnimalName)

        ' Easy appending of new code
        colAnimalCodes.Add lngAnimalCode
    Next 
End Sub