Question

前言：我非常喜欢编码，我对目前的代码不起作用并不感到惊讶，但我无法理解我是否尝试了一种根本不可能的方法，或者我是否只是不理解正确的语法。与我目前的项目代码中的大部分内容不同，我还没有在这里的许多其他帖子中找到解决方案。

背景：扮演精英：危险。我在Excel工作表中有一个星系统列表，每行包含一个系统（列：名称，x，y，z坐标，以及一些属性，如Visited，RareGoodsSource）。我创建了一个StarSystem类，并将工作表读入StarSystems集合（名为colSys）。这有效。对于类的每个属性，我有一个单独的工作表（列：名称，属性），我手动调整属性值（例如，在游戏中访问过Tau Ceti，在工作表＆＃34; csvVisited＆＃34;手动添加行＆＃34; Tau Ceti＆＃34;，＆＃34; TRUE＆＃34;）。在VBA中，然后将它们与Collection元素中的值进行比较，并在必要时更新后者。（最后，我将所有这些内容抽到AutoCAD上，以便可视化和规划旅行路线。）

问题：我目前每个属性都有一个单独的Sub，除了工作表的名称外都是相同的（例如＆＃34; csv 访问＆＃34; / ＆＃34; csv RareGoodsSource ＆＃34;）以及访问该属性的引用（例如colSys.Item（r.Value）。访问 / colSys.Item（r .value的）。的 RareGoodsSource ）。这有效。但从美学，效率和维护的角度来看似乎错了。当然我应该只有一个Sub，我根据需要传递访问或 RareGoodsSource ？

此通用子代码的当前代码位于帖子的末尾，为了清晰起见，我首先提供了一个非常抽象的版本。我的第一次尝试是简单地在Sub中的 strProperty 替换访问，并将访问或 RareGoodsSource 传递给Sub成为该字符串变量。

这适用于工作表引用，可能是因为.Item（）无论如何都需要一个字符串。我并不完全惊讶它不适用于属性引用，因为我传递了一个字符串变量希望VBA将其理解为对象属性名称，但我一直无法找到应该如何执行此操作。希望这只是我尴尬缺乏基本编程知识的结果，我只需要一些括号或引号或者某处。

简化的示例代码，它可以正常工作（......除了显然没有的位）：

Sub TestVisited()
    Call TestGeneric("Visited")
End Sub

Sub TestGeneric(strProperty As String)
    Dim wsCSV As Worksheet
    Set wsCSV = ActiveWorkbook.Worksheets.Item("csv" & strProperty)
    'successfully sets wsCSV to Worksheets.Item("csvVisited"),
    'presumably because .Item() expects a string anyway.

    Dim r As Range
    For Each r In wsCSV.Range(wsCSV.Cells(2, 1), wsCSV.Cells(4, 1))
        Debug.Print "Explicitly coded: " & colSys.Item(r.Value).Visited
        Debug.Print "Passed as string: " & colSys.Item(r.Value).strProperty
    Next r
    'The first Debug.Print works, the second does not:
    '"Object doesn't support this property or method."
End Sub

上下文的当前实际代码：

（注意我已经在.Contains替换上禁用了错误陷阱，否则会导致此问题。）

Sub UpdatePropertyFromWorksheetCSVProperty(strProperty As String)

    'set the cell column/row positions in Worksheets.
    Let celCSVDataColumn = 2

    'prepare reference to Worksheet to read.
    Dim wsCSV As Worksheet
    Set wsCSV = ActiveWorkbook.Worksheets.Item("csv" & strProperty)

    'prepare reference to Range to read.
    Dim rngData As Range
    Set rngData = wsCSV.Range(wsCSV.Cells(celFirstDataRow, celKeyColumn), wsCSV.Cells( _
        wsCSV.Cells(wsCSV.Rows.Count, celKeyColumn).End(xlUp).Row _
        , celKeyColumn)) ' middle segment finds the last occupied cell in column A and returns its row index.

    'for each Worksheet row, compare the property value in the Worksheet to the value in the Collection Element,
    'if different write the Worksheet value to the Collection Element, and flag the Element as ModifiedSinceRead.
    Dim r As Range

    For Each r In rngData
        'check Sytem exists in the Collection.
        'except VBA Collections don't have a .Contains method apparently.
        'use error trapping instead.
        'On Error GoTo ErrorHandler
            'compare/copy Worksheet and Collection values.
            If Not colSys.Item(r.Value).strProperty = r.Offset(0, celCSVDataColumn - 1).Value Then
        On Error GoTo 0 'disables error trap again.
                Let colSys.Item(r.Value).strProperty = r.Offset(0, celCSVDataColumn - 1).Value
                Let colSys.Item(r.Value).xlsModifiedSinceRead = True
                'DEBUG: test to immediate window
                Debug.Print "System " & colSys.Item(r.Value).Name & " " & strProperty & " property changed to " & colSys.Item(r.Value).strProperty & "."
                '
            End If

ResumeNextSystem:
    Next r

    'DEBUG: test to immediate window
    Debug.Print colSys(1).Name & vbTab & colSys(1).x & vbTab & colSys(1).RareGoodsSource & vbTab & colSys(1).RareGoodsChecked & vbTab & colSys(1).Visited & vbTab & colSys(1).xlsModifiedSinceRead
    Debug.Print colSys(10160).Name & vbTab & colSys(10160).x & vbTab & colSys(10160).RareGoodsSource & vbTab & colSys(10160).RareGoodsChecked & vbTab & colSys(10160).Visited & vbTab & colSys(10160).xlsModifiedSinceRead
    Debug.Print colSys("Lave").Name & vbTab & colSys("Lave").x & vbTab & colSys("Lave").RareGoodsSource & vbTab & colSys("Lave").RareGoodsChecked & vbTab & colSys("Lave").Visited & vbTab & colSys("Lave").xlsModifiedSinceRead
    '

    Exit Sub
ErrorHandler:
    MsgBox ("Processing Worksheet " & wsCSV.Name & " error at system " & r.Value & ", skipping to next.")
    'DEBUG: test to immediate window
    Debug.Print "Processing Worksheet " & wsCSV.Name & " error at system " & r.Value & ", skipping to next."
    '

    Resume ResumeNextSystem

End Sub

实际代码中的解决方案：

'stays as-is:
Set wsCSV = ActiveWorkbook.Worksheets.Item("csv" & strProperty)

'Get old:
If Not colSys.Item(r.Value).strProperty = r.Offset(0, celCSVDataColumn - 1).Value Then
'new:
If Not CallByName(colSys.Item(r.Value), strProperty, VbGet) = r.Offset(0, celCSVDataColumn - 1).Value Then

'Let old:
Let colSys.Item(r.Value).strProperty = r.Offset(0, celCSVDataColumn - 1).Value
'new:
CallByName colSys.Item(r.Value), strProperty, VbLet, r.Offset(0, celCSVDataColumn - 1).Value

Answer 1

您可以使用 CallByName 内置函数来获取属性。

v = CallByName(colSys.Item(r.Value), strProperty, vbGet)

此知识库文章解释了它：https://support.microsoft.com/kb/186143

使用传递的字符串来访问不同的类属性

1 个答案: