0

我正在使用这个 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
4

1 回答 1

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
于 2013-07-19T18:03:40.250 回答