Excel 运行时的对象属性

我想动态写入自定义类属性。在我的用例中，我有一个带有列标题的表。标题是

问题

类的属性。每期有120多列。最终用户选择要包含在报告中的列。在运行时才知道列的情况下，如何设置对象的属性？我在谷歌上找不到任何有用的东西

为清晰起见进行了编辑

下面是我的

CIssue

类的一个片段：

Option Explicit

Private pIncidentNumber As String
Private pIncidentType As String
Private pContent As String
Private pStartDate As Date
Private pEndDate As Date


Public Property Let IncidentNumber(Value As String)
    pIncidentNumber = Value
End Property
Public Property Get IncidentNumber() As String
    IncidentNumber = pIncidentNumber
End Property
Public Property Let IncidentType(Value As String)
    pIncidentType = Value
End Property
Public Property Get IncidentType() As String
    IncidentType = pIncidentType
End Property
Public Property Let Content(Value As String)
    pContent = Value
End Property
Public Property Get Content() As String
    Content = pContent
End Property
Public Property Let StartDate(Value As Date)
    pStartDate = Value
End Property
Public Property Get StartDate() As Date
    StartDate = pStartDate
End Property
Public Property Let EndDate(Value As Date)
    pEndDate = Value
End Property
Public Property Get EndDate() As Date
    EndDate = pEndDate
End Property

它除了帮助组织我的代码外，什么也不做。我也将为此构建一个集合类。如果最终用户选择了

事件编号

和

内容

列，我想设置相应的属性。最多可以有1000行数据。因此，我需要为符合条件的行设置属性

示例

我可能有72行符合标准。因此，我需要向我的集合中添加72个类型为

CIssue

的对象，并根据最终用户选择的列设置正确的属性

谢谢

核心问题： 仅在根据列表视图选择的

CIssue

对象中创建属性

对于第一期，我创建了一个工作表（“Sheet1”），在其中添加了ActiveX

ListView

（MicroSoft ListView控件，版本6.0），并在常规模块中填充了列标题（或属性名称），如下所示：

Option Explicit
Sub PopulateListView()
Dim i As Integer
i = 1
With Worksheets("Sheet1")
    .TestListView.ListItems.Clear
    Do While Not IsEmpty(.Cells(1, i))
        .TestListView.ListItems.Add i, , .Cells(1, i).Value
        i = i + 1
    Loop
End With
End Sub

Option Explicit
Public Issue As CIssue
Public Issues As Collection
Public lv As ListView
Sub TestCreateIssues()
Dim i As Integer
Dim Item As ListItem

Set lv = Worksheets("Sheet1").TestListView
Set Issues = New Collection

For i = 2 To 10 'Or however many rows you filtered, for example those 72.
    Set Issue = New CIssue
    For Each Item In lv.ListItems 'Loop over ListItems
        If Item.Checked = True Then ' If the property is selected
            Issue.AddProperty Item.Text, Worksheets("Sheet1").Cells(i, Item.Index).value 'Get the property name and value, and add it.
        End If
    Next Item
    Issues.Add Issue
Next i
End Sub

我设置了以下属性：

• 复选框

  至

  True

• MultiSelect

  到

  True

这将允许我们在所选项目上循环，并相应地在

CIssue

类中创建属性

接下来，我添加了对

MicroSoft脚本运行时

的引用，因此

字典

类可用。这是必需的，因为对于

集合

类，无法通过“键”（或属性名称，如下所示）轻松检索“属性”

我创建了

CIssue

类，如下所示：

Option Explicit
Private p_Properties As Dictionary
Private Sub Class_Initialize()
    Set p_Properties = New Dictionary
End Sub
Public Sub AddProperty(propertyname As String, value As Variant)
    p_Properties.Add propertyname, value
End Sub
Public Function GetProperty(propertyname As Variant) As Variant
    On Error Resume Next
        GetProperty = p_Properties.Item(propertyname)
    On Error GoTo 0
    If IsEmpty(GetProperty) Then
        GetProperty = False
    End If
End Function
Public Property Get Properties() As Dictionary
    Set Properties = p_Properties 'Return the entire collection of properties
End Property

这样，您可以在常规模块中执行以下操作：

Option Explicit
Sub PopulateListView()
Dim i As Integer
i = 1
With Worksheets("Sheet1")
    .TestListView.ListItems.Clear
    Do While Not IsEmpty(.Cells(1, i))
        .TestListView.ListItems.Add i, , .Cells(1, i).Value
        i = i + 1
    Loop
End With
End Sub

Option Explicit
Public Issue As CIssue
Public Issues As Collection
Public lv As ListView
Sub TestCreateIssues()
Dim i As Integer
Dim Item As ListItem

Set lv = Worksheets("Sheet1").TestListView
Set Issues = New Collection

For i = 2 To 10 'Or however many rows you filtered, for example those 72.
    Set Issue = New CIssue
    For Each Item In lv.ListItems 'Loop over ListItems
        If Item.Checked = True Then ' If the property is selected
            Issue.AddProperty Item.Text, Worksheets("Sheet1").Cells(i, Item.Index).value 'Get the property name and value, and add it.
        End If
    Next Item
    Issues.Add Issue
Next i
End Sub

从而得到一个

集合

的

cisue

对象，这些对象只填充了所需的属性。您可以使用

CIssue.GetProperty（propertyname）

检索每个属性。如果属性不存在，则返回“False”，否则返回属性的值。由于它返回

Variant

，因此它将适应日期、字符串等。 请注意，如果要循环过滤的行，可以相应地修改上面的循环。请注意，

GetProperty

方法的

propertyname

参数也是一个变量-这允许您传入字符串以及实际的

键

对象

要用这种方式捕获的内容填充另一张工作表，您可以执行以下操作（在相同或不同的模块中；请注意，需要首先运行上面的

子
，否则您的CI集合将不存在

Sub TestWriteIssues()
Dim i As Integer
Dim j As Integer
Dim Item As ListItem
Dim p As Variant
Dim k As Variant

i = 1
j = 0
'To write all the properties from all issues:
For Each Issue In Issues
    i = i + 1
    For Each p In Issue.Properties.Items
        j = j + 1
        Worksheets("Sheet2").Cells(i, j).value = p
    Next p
    j = 0
Next Issue

'And add the column headers:
i = 0
For Each k In Issues.Item(1).Properties.Keys
    i = i + 1
    Worksheets("Sheet2").Cells(1, i).value = k
    'And to access the single property in one of the Issue objects:
    MsgBox Issues.Item(1).GetProperty(k)
Next k
End Sub

希望这或多或少是你想要的

注意：更多关于为什么在
中选择
字典
而不是
集合
的背景知识使用
字典
怎么样？@MathieuGuindon嗯，我想到了类似的事情，但是用案例陈述。但我不明白如何使用它来获取和设置属性。你能提供一个实践吗所有简单的示例？创建一个字典，用列名为其键入，并存储一个
布尔值
，指示该列是否应包含在报告中？实际上有数千个
脚本编写。字典
示例。它完全不需要这些属性中的每一个？这是道具什么是名称/值映射？@MathieuGuindon我编辑了我的问题。希望现在问题更清楚了。这肯定是“或多或少”我一直在寻找的。就在今天早上，我开始在我的课堂上实现
字典
。我的一个朋友推荐了上面的一个变体，使用列名作为字典键，零基整数作为值。然后循环过滤数组值。这是我无法理解的。谢谢你r花时间进行此操作。标记为正确且+1。