在VBA函数中实现结构化引用

时间:2013-07-19 17:50:26

标签: excel-vba excel-2010 vba excel

我正在使用此VBA功能,现在它工作正常,因为我的电子表格格式没有改变。但我会将它改编为另一种用途,订单可能会更频繁地改变。我对此函数所需的表头名称不会更改其名称。我的整个电子表格方程式已经使用了结构化引用,但我正在努力解决如何消除VBA代码中列位置的显式引用的残余。

说明If data(i, 2).Value = expNum Then

的行
If data(i, 14).Value <> Empty Then 
    curEnergy = data(i, 14).Value`

有问题吗?第2列对应于一个名为“Exp#”的列,第14列对应于列名“G(kcal / mol)”我附上了下面的完整函数,以防万一其他部分中有关键部分我'我不知道。我想用结构化参考替换那些对2和14的引用,或者用一些强大的东西来替代列位置的重新排序。

Function BoltzmannEnergy(expNum As String) As Double
Application.Volatile

Worksheets("Raw Values").Activate
Dim data As Range, curCell As Range
Dim numRows As Integer, arrayCount As Integer, arraySize As Integer
Dim energies() As Double, curEnergy As Double, minEnergy As Double, RT As Double, BoltzTop As Double, BoltzBtm As Double
Dim expFound As Boolean
Const T As Double = 298
Const R As Double = 0.001985

RT = R * T
BoltzTop = 0
BoltzBtm = 0
expFound = False

arraySize = 5
minEnergy = 0
ReDim energies(0 To arraySize)

Set data = Range("RawValues")
arrayCount = 0
numRows = data.Rows.Count

For i = 1 To numRows
    If data(i, 2).Value = expNum Then
        If arrayCount = UBound(energies) - 1 Then
            ReDim Preserve energies(0 To arrayCount + arraySize + 1)
        End If

        expFound = True
        If data(i, 14).Value <> Empty Then
            curEnergy = data(i, 14).Value
            If curEnergy <> 0 Then
                If curEnergy < minEnergy Then
                    minEnergy = curEnergy
                End If
                energies(arrayCount) = curEnergy
                arrayCount = arrayCount + 1
            End If
        End If
    ElseIf expFound = True Then
        Exit For
    End If
Next i

For i = 0 To arrayCount - 1
BoltzTop = BoltzTop + energies(i) * Exp(-(energies(i) - minEnergy) / RT)
BoltzBtm = BoltzBtm + Exp(-(energies(i) - minEnergy) / RT)
Next i

BoltzmannEnergy = BoltzTop / BoltzBtm

End Function

1 个答案:

答案 0 :(得分:2)

如果您知道标题名称不会更改,则可以使用两个变量替换这些数字,每个变量都指向一个find range.columns。

类似的东西:

Dim intColumn1, intColumn2 As Integer
Dim rngTemp As Range
'assuming your header row is row 1
Set rngTemp = Worksheets("Raw Values").Rows(1).Find(what:="Header_1_value")
'check if you actually found a cell
If Not rngTemp Is Nothing Then
    intColumn1 = rngTemp.Column
End If

'assuming your header row is row 1
Set rngTemp = Worksheets("Raw Values").Rows(1).Find(what:="Header_2_value")
'check if you actually found a cell
If Not rngTemp Is Nothing Then
    intColumn2 = rngTemp.Column
End If