对于 Excel VBA 中的每个类属性

Posted 2023-02-24

【中文标题】对于 Excel VBA 中的每个类属性

【英文标题】：For Each Class Property in Excel VBA

【发布时间】：2013-06-15 05:35:59

【问题描述】：

我有一些看起来像这样的代码：

pos.Clutch = sh2.Cells(R, Clutch)
pos.Wiper = sh2.Cells(R, Wiper)
pos.Alternator = sh2.Cells(R, Alternator)
pos.Compressor = sh2.Cells(R, Compressor)
...
pos.Telephone = sh2.Cells(R, Telephone)
poss.Add pos

poss 是一个集合，Clutch、Wiper 等是列索引（从 1 开始）。这目前有效，但非常难看。我正在寻找一种方法来做这样的事情......

Do While i <= classProperty.count
    For each classProperty in pos
        classProperty = sh2.Cells(R + 1, i)
    Next classProperty
Loop

显然这行不通，但有人对如何在一个类中创建一个大致相同的方法或集合有任何建议吗？

【问题讨论】：

由于您的索引从 1 开始，使用子集合而不是类可能更整洁，因此您可以使用 pos.add sh2.Cells(R,i) 循环列索引。然后使用列索引访问值，例如pos(Clutch)。

【参考方案1】：

我不知道有什么好方法。它丑陋的唯一原因是你还没有在课堂上隐藏它。采取这个程序

Sub Main()

    Dim clsPos As CPos
    Dim clsPoses As CPoses

    Set clsPoses = New CPoses
    Set clsPos = New CPos

    clsPos.AddFromRange Sheet1.Range("A10:E10")
    clsPoses.Add clsPos

End Sub

这没什么难看的。现在 AddFromRange 方法有点难看，但你只需要在编写它或数据更改时查看它。

Public Sub AddFromRange(ByRef rRng As Range)

    Dim vaValues As Variant

    vaValues = rRng.Rows(1).Value

    Me.Clutch = vaValues(1, 1)
    Me.Wiper = vaValues(1, 2)
    Me.Alternator = vaValues(1, 3)
    Me.Compressor = vaValues(1, 4)
    Me.Telephone = vaValues(1, 5)

End Sub

更新：吃数组而不是 Range 的替代方法。

Public Sub AddFromArray(vaValues as Variant)

    Me.Clutch = vaValues(1, 1)
    Me.Wiper = vaValues(1, 2)
    Me.Alternator = vaValues(1, 3)
    Me.Compressor = vaValues(1, 4)
    Me.Telephone = vaValues(1, 5)

End Sub

【讨论】：

我也试试这个。设置比@CuberChase 建议的更容易，并且添加新属性仍然很容易。

嗯。 @dickkusleika 我改变了我的代码，以便将整个范围转储到一个数组中。如何使 .AddFromRange 对数组仍然有效？

我会做一个吃数组的新方法。我不是万能方法的粉丝。查看更新。

啊，感谢您非常及时的回复。下周我会看看它的效果如何。 “万能方法”到底是什么意思？有什么缺点？

我的意思是可以使用任何东西的方法：范围、数组、集合、字典。它们变得杂乱无章，难以维护。

【参考方案2】：

正如其他人所说，没有直接的方法可以遍历对象属性。我有一个电子表格，其中存储了许多我需要在运行时读取的值，类似于你的。我发现最好的方法是使用CallByName 方法，它允许您通过name 设置或获取属性。

现在，有些人可能会说初始设置是多余的，但我经常添加和删除这些属性，因此对代码进行同样的设置更加麻烦。 因此，这种方法的美妙之处在于您可以经常修改您的属性数量，而无需更改此代码。您可以从这里使用 CallByName 的出色功能：https://***.com/a/5707956/1733206 p>

那么对于您的示例，我将在我的 poss 集合中执行以下操作（请注意，这不会执行您可能想做的任何错误检查等）：

Public Sub ReadInData()
    Dim vInputs As Variant, ii As Integer, jj As Integer, cp As pos
    Dim sPropertyName As String, vPropertyValue As Variant

    'Raead in the data.  I've set it from the activesheet, you can do it how you like
    With ActiveSheet
        vInputs = .Range(.Cells(1, 1), .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).Value2
    End With

    'Look through the rows of data, one row per 'pos' object
    For ii = LBound(vInputs, 1) + 1 To UBound(vInputs, 1)

        'Set up your object
        Set cp = New pos

        'Loop through the columns of data eg Clutch, wiper, etc
        For jj = LBound(vInputs, 2) To UBound(vInputs, 2)
            'Put in seperate variables so its easy to see what's happening
            sPropertyName = vInputs(1, jj)
            vPropertyValue = vInputs(ii, jj)

            'Use the callable method to set the property (from here: https://***.com/a/5707956/1733206)
            Call SetProperty(sPropertyName, vPropertyValue, cp)
        Next jj

        Me.Add cp
        Set cp = Nothing
    Next ii
End Sub

这是工作簿中的一个示例：https://dl.dropboxusercontent.com/u/13173101/VBAObject.xlsm

编辑：由于您将经常更改对象，因此我包含了另一个非常方便的模块，实际上会编写 pos 类为您提供基础在工作表的列标题上。这意味着如果您添加另一列，它会将这些属性添加到对象中！它假定所有属性都是字符串，但您可以修改以适应。

【讨论】：

我会看看这是否可行——它应该。我也必须经常添加新属性，所以这是一个理想的解决方案。谢谢！

很高兴它有帮助。我做了一个稍微偏离主题的编辑，我很确定你会想看看。

【参考方案3】：

VBA 类不允许定义构造函数。

在主模块中，我将创建一个“创建者”：

  For R = R1 To R2
    pos.Add NewPos(Range("A" & R & ":E" & R)
  Next R

Function NewPos(R As Range) As classProperty
  Set NewPos = New ClassProperty
  NewPos.Init(R)
Exit Function

在课堂上：

Sub Init(R As Range)
  Clutch = R.Cells(1, 1)
  Wiper = R.Cells(1, 2)
  ...
End Sub

【参考方案4】：

也许可以使用一些这样的代码。因为这是打印出每个程序和属性的想法：

Function getPropCount(ClassName As String) As String 
   Dim classes, Class 
   Dim i As Integer 
   Dim strClass As String 
   Dim propCount As Integer

   For Each classes In Application.VBE.CodePanes
      If classes.CodeModule.Name = ClassName Then
         Set Class = classes
      End If 
   Next
   For i = 1 To Class.CodeModule.CountOfLines
      If Class.CodeModule.ProcOfLine(i, 1) <> strClass Then
         strClass = Class.CodeModule.ProcOfLine(i, 1)
         Debug.Print strClass
         propCount = propCount + 1
      End If 
   Next 
   getPropCount = propCount
End Function

祝你好运，LC