使用传递的string来访问不同的类属性
前言：我非常擅长编码，我并不感到惊讶，我现在的代码不起作用，但是我不知道我是在尝试一种根本不可能的方法，或者我只是不喜欢不理解正确的语法。 与我当前项目代码的其余大部分不同，我还没有在其他许多post中find解决scheme。
背景：打精英：危险。 我有一个Excel工作表中的星形系统列表，每行包含一个系统（列：名称，x，y，z坐标，以及一些属性，如Visited，RareGoodsSource）。 我创build了一个StarSystem类并将工作表读入StarSystems集合（名为colSys）。 这工作。 对于每个类的属性，我有一个单独的工作表（列：名称，财产），我手动调整属性值（例如刚刚访问的Tau Ceti在游戏中，在工作表上“csvVisited”手动添加行“Tau Ceti”，“TRUE”） 。 在VBA中，我将它们与Collection元素中的值进行比较，如果需要的话更新后者。 （最后，我将所有这些东西都加到AutoCAD中，以便可视化和规划出行路线。）
问题：我目前每个属性都有一个单独的Sub，除了工作表名称（例如“csv Visited ”/“csv RareGoodsSource ”）和访问属性的引用（例如colSys.Item（r.Value））以外，其他都相同。 Visited / colSys.Item（r.Value） .RareGoodsSource ）。 这工作。 但是从美学，效率和维护的angular度来看似乎是错误的。 当然，我应该只有一个小组，我根据需要通过访问或稀有资源 ？
我目前的代码为这个通用的子是在post的结尾，首先我有一个非常抽象的版本为清晰。 我的第一个尝试是简单地用Sub 属性中的strProperty代替Visited ，并将Visited或RareGoodsSource传递给Sub中的stringvariables。
这对工作表的引用工作正常，大概是因为.Item（）无论如何需要一个string。 我不完全感到惊讶，它不适用于属性引用，因为我传递一个stringvariables希望VBA了解这是一个对象的属性名称，但我一直无法find如何做到这一点。 希望这只是我缺乏基本编程知识的尴尬的结果，我只需要一些括号或引号或在某处。
简单的示例代码，它可以正常工作（…除了不显示的位）：
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 上下文的当前实际代码：
（注意，我已经禁用了.Containsreplace中的错误陷阱，因为否则就会陷入这个问题。）
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
您可以使用CallByName内置函数来获取属性。
v = CallByName(colSys.Item(r.Value), strProperty, vbGet)
这篇知识库文章解释了这个问题： https ： //support.microsoft.com/kb/186143