将选定范围分配给二维数组并比较 2 个数组 VBA
Assign selected range to two-dimentional array and compare 2 arrays VBA
我被困了几个小时来解决我的案子。下面包含代码，我将首先解释我的案例，以便更好地理解和更容易理解。
我创建了一个二维数组，其中包含多种化合物以及它们在两个温度下的相应热值 - 它包含在代码中，用户看不到它。
用户在单元格中输入化合物和混合物的百分比，我希望将构成多行两列数组的selected单元格添加到二维数组，然后在创建的函数中用于计算某个值（如所附屏幕截图所示）。
最终，我希望程序搜索用户输入的 selected table 以将并集名称与数组匹配，该数组“隐藏”在代码中以正确执行代数运算操作。
代码:
Function LoopThroughArray(T, x)
Dim arr() As Variant
ReDim arr(2, 4)
arr(0, 0) = "CH4"
arr(0, 1) = 35.818
arr(0, 2) = 35.808
arr(1, 0) = "C2H6"
arr(1, 1) = 63.76
arr(1, 2) = 63.74
arr(2, 0) = "C3H8"
arr(2, 1) = 91.18
arr(2, 2) = 91.15
Dim arrUser() As Variant
ReDim arrUser(2, 4)
arrUser(0, 0) = "CH4"
arrUser(0, 1) = 0.7
arrUser(1, 0) = "C2H6"
arrUser(1, 1) = 0.3
'declare variables for the loop
Dim i As Long, j As Long
'loop for the first dimension
For i = LBound(arr, 1) To UBound(arr, 1)
'loop for the second dimension
For j = LBound(arr, 2) To UBound(arr, 2)
If T = 0 And arr(i, j) = "CH4" And arrUser(i, j) = "CH4" Then
LoopThroughArray = arr(i, j + 1) * x 'the X is concentration of CH4 selected by user
Else
If T = 25 And arr(i, j) = "CH4" And arrUser(i, j) = "CH4" Then
LoopThroughArray = arr(i, j + 2) * x 'the X is concentration of CH4 selected by user
End If
End If
Next j
Next i
End Function
来自 Excel 的屏幕截图：
我还附上了一张截图，显示了代码中嵌入的 table 的值，以及该函数最终如何工作。
问题：
目前，我编写的代码仅在函数用于 CH4 化合物且用户手动 select 包含浓度值的单元格（我的代码中为 x）时才有效。
我应该如何修改代码，让function/loop搜索用户输入的table，将其中的化合物名称与内置table中的化合物名称进行匹配在代码中并计算以下形式的值：浓度（用户定义，目前我的代码中的 x 值）* 特定化合物在所需温度（0 或 25 度）下的 LHV。
1.编辑：
我需要更改什么才能使函数独立于 compounds/concentrations 是不是按列输入而是按行输入？
2。编辑：
我稍微更改了代码，在化合物的内置数组中，值是通过采用函数中设置的温度“T”的多项式计算的。
一个。我已经创建了“如果”条件来通知错误输入的数据。我为此使用了 WorksheetFunction.[...] （我想知道使用此选项是否是解决问题的正确方法）。当我在另一个工作表中使用该功能时，一条消息会在满足条件时激活来自其他单元格的消息。即使我启动 excel 文件，也会弹出消息。
问题1：我应该如何更改下面的代码，以便在输入公式时（满足假定条件时）仅弹出一次消息？
b。 问题2：如何创造条件：
-当函数中输入的温度低于selected化合物的25度时，将弹出一条消息通知您（这适用于所有化合物，包括空气），
-当函数中输入的温度高于 2200 度时，selected 化合物将出现空气，将出现一条消息，通知空气温度超出范围，
-如果函数中输入的温度对于 selected 化合物高于 3000 度，则会出现一条消息，通知温度超出范围。
示例：
代码：
Public Function Cp_mix_t(T, compounds As Range, concentrations As Range) As Double
Dim arr() As Variant
Dim i As Long, j As Long, k As Long
Dim curRow As Range
Dim ret As Double, x As Double
TN=273
'Array of compounds and polynomials defining Cp
ReDim arr(29, 2)
arr(0, 0) = "CH4"
arr(0, 1) = -1.9E-14 * (T + TN) ^ 5 + 2.1E-10 * (T + TN) ^ 4 - 7.1E-07 * (T + TN) ^ 3 + 7.8E-04 * (T + TN) ^ 2 + 1.4 * (T + TN) ^ 1 + 1709.8
arr(20, 0) = "N2"
arr(20, 1) = -3.5E-15 * (T + TN) ^ 5 + 3.9E-11 * (T + TN) ^ 4 - 1.61E-07 * (T + TN) ^ 3 + 2.87E-04 * (T + TN) ^ 2 - 0.17 * (T + TN) ^ 1 + 1054.5
arr(28, 0) = "AIR"
arr(28, 1) = -9.8E-15 * (T + TN) ^ 5 + 8.4E-11 * (T + TN) ^ 4 - 2.7E-07 * (T + TN) ^ 3 + 4.1E-04 * (T + TN) ^ 2 - 0.16 * (T + TN) ^ 1 + 1027.9
concentrationHasRows = True
If concentrations.Columns.Count > 1 Then
concentrationHasRows = False
End If
For Each Cell In concentrations 'It checks if negative values of percentages in selected cells have been entered. If so, a warning appears and the program does not count Cp - it gives a value of 0
If Cell.Value < 0 Then
MsgBox ("A negative value was entered!")
Cp_mix_t = 0
Exit Function
End If
Next Cell
If compounds.Count <> concentrations.Count Then 'It checks if the number of entered compounds matches the number of entered percentages. If not, a message appears and the program does not count Cp - it gives a value of 0
MsgBox ("Wrong selection! Check the selected range of compounds/percentages.")
Cp_mix_t = 0
Exit Function
ElseIf WorksheetFunction.Sum(concentrations) > 1 Then 'It checks if the sum of percentages >100%. If so, a warning appears and the program does not count Cp - it gives a value of 0
MsgBox ("Sum of percentages greater than 100%!")
Cp_mix_t = 0
Exit Function
ElseIf WorksheetFunction.Sum(concentrations) > 0 And WorksheetFunction.Sum(concentrations) < 1 Then 'It checks if the sum of the percentages =100%. If yes, then only the message
MsgBox ("The sum of the percentages is not equal to 100%!")
End If
' Loop through user input rows:
k = 1
For Each m In compounds
arraycompound = Trim(UCase(m.Value2))
For i = 0 To UBound(arr, 1)
If arr(i, 0) = arraycompound Then
' x retrieves user's input of concentration:
If concentrationHasRows Then
x = concentrations.Cells(k, 1).Value2
Else
x = concentrations.Cells(1, k).Value2
End If
If T < 25 Then
MsgBox ("Temperature below 25 deg")
ElseIf T > 2200 And arr(i, 0) = "AIR" Then
MsgBox ("Temperature for air above 2200 deg ")
' ElseIf T > 3000 And arr(i, 0) = Not "AIR" Then
' MsgBox ("Temperature for compounds above 3000 deg")
End If
ret = ret + arr(i, j + 1) * x
Exit For
End If
Next
k = k + 1
Next
Cp_mix_t = ret
End Function
(Re-edited)
我找到了这个可能的解决方案。数据模块中的代码为：
' call the function like in =LHV(25;A9:B10;E5:E6)
Function LHV(T, compounds As Range, concentrations As Range) As Double
Dim rng1 As Range, rng2 As Range
If ThisWorkbook.done = False Then
ThisWorkbook.numMsg = 0
ThisWorkbook.done = True
For Each cell In compounds.Application.ActiveSheet.UsedRange
If cell.HasFormula Then
' change down here "LHV(" by your formula's name:
If InStr(Replace(UCase(cell.Formula), " ", ""), "LHV(") Then
v = Split(cell.Formula, ",") ' code arrives here?
pos = InStr(v(0), "(")
v(0) = Mid(v(0), pos + 1)
Set rng1 = Range(v(1))
v(2) = Replace(v(2), ")", "")
Set rng2 = Range(v(2))
cellLHV v(0), rng1, rng2
End If
End If
Next
End If
If ThisWorkbook.numMsg And 1 Then
MsgBox ("Temperature below 25 deg")
End If
If ThisWorkbook.numMsg And 2 Then
MsgBox ("Temperature for air above 2200 deg ")
End If
If ThisWorkbook.numMsg And 4 Then
' MsgBox ("Temperature for compounds above 3000 deg")
End If
If ThisWorkbook.numMsg And 8 Then
' MsgBox ("Some other message")
End If
ThisWorkbook.numMsg = 0
LHV = cellLHV(T, compounds, concentrations)
ThisWorkbook.done = False
End Function
Function cellLHV(T, compounds As Range, concentrations As Range) As Double
Dim arr() As Variant
Dim strFind As String
Dim i As Long, j As Long, k As Long
Dim curRow As Range
Dim ret As Double, x As Double
ReDim arr(2, 4)
arr(0, 0) = "CH4"
arr(0, 1) = 35.818
arr(0, 2) = 35.808
arr(1, 0) = "C2H6"
arr(1, 1) = 63.76
arr(1, 2) = 63.74
arr(2, 0) = "C3H8"
arr(2, 1) = 91.18
arr(2, 2) = 91.15
concentrationHasRows = True
If concentrations.Columns.Count > 1 Then
concentrationHasRows = False
End If
' Loop through user input rows:
k = 1
For Each m In compounds
arraycompound = Trim(UCase(m.Value2))
For i = 0 To UBound(arr, 1)
If arr(i, 0) = arraycompound Then
' x retrieves user's input of concentration:
If concentrationHasRows Then
x = concentrations.Cells(k, 1).Value2
Else
x = concentrations.Cells(1, k).Value2
End If
If T < 25 Then
ThisWorkbook.numMsg = ThisWorkbook.numMsg Or 1
ElseIf T > 2200 And arr(i, 0) = "AIR" Then
ThisWorkbook.numMsg = ThisWorkbook.numMsg Or 2
'ElseIf T > 3000 And arr(i, 0) = Not "AIR" Then
'ThisWorkbook.numMsg = ThisWorkbook.numMsg Or 4
' ElseIf ..... then
'ThisWorkbook.numMsg = ThisWorkbook.numMsg Or 8
End If
ret = ret + arr(i, j + 1) * x
Exit For
End If
Next
k = k + 1
Next
cellLHV = ret
End Function
...以及 Data 的 ThisWorkbook 中的代码：
Public numMsg As Long
Public done As Boolean
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
ThisWorkbook.done = False
End Sub
同时将 arr() 转换为全局 Public 变量速度可以提高。
如果温度 T 将成为单元格范围，则将函数更改为：
Public Function Cp_mix_t(T, compounds As Range, concentrations As Range) As Double
Dim rng1 As Range, rng2 As Range
Dim rng0 As Range
If ThisWorkbook.done = False Then
ThisWorkbook.numMsg = 0
ThisWorkbook.done = True
For Each cell In compounds.Application.ActiveSheet.UsedRange
If cell.HasFormula Then
If InStr(Replace(cell.Formula, " ", ""), "Cp_mix_t(") Then
v = Split(cell.Formula, ",")
pos = InStr(v(0), "(")
v(0) = Mid(v(0), pos + 1)
Set rng0 = Range(v(0))
Set rng1 = Range(v(1))
v(2) = Replace(v(2), ")", "")
Set rng2 = Range(v(2))
' code arrives here ?
cellCp_mix_t rng0, rng1, rng2
End If
End If
Next
End If
If ThisWorkbook.numMsg And 1 Then
MsgBox ("Temperature below 25 deg")
End If
If ThisWorkbook.numMsg And 2 Then
MsgBox ("Temperature for air above 2200 deg ")
End If
If ThisWorkbook.numMsg And 4 Then
' MsgBox ("Temperature for compounds above 3000 deg")
End If
If ThisWorkbook.numMsg And 8 Then
' MsgBox ("Some other message")
End If
ThisWorkbook.numMsg = 0
Cp_mix_t = cellCp_mix_t(T, compounds, concentrations)
ThisWorkbook.done = False
End Function
我被困了几个小时来解决我的案子。下面包含代码，我将首先解释我的案例，以便更好地理解和更容易理解。
我创建了一个二维数组，其中包含多种化合物以及它们在两个温度下的相应热值 - 它包含在代码中，用户看不到它。
用户在单元格中输入化合物和混合物的百分比，我希望将构成多行两列数组的selected单元格添加到二维数组，然后在创建的函数中用于计算某个值（如所附屏幕截图所示）。
最终，我希望程序搜索用户输入的 selected table 以将并集名称与数组匹配，该数组“隐藏”在代码中以正确执行代数运算操作。
代码:
Function LoopThroughArray(T, x)
Dim arr() As Variant
ReDim arr(2, 4)
arr(0, 0) = "CH4"
arr(0, 1) = 35.818
arr(0, 2) = 35.808
arr(1, 0) = "C2H6"
arr(1, 1) = 63.76
arr(1, 2) = 63.74
arr(2, 0) = "C3H8"
arr(2, 1) = 91.18
arr(2, 2) = 91.15
Dim arrUser() As Variant
ReDim arrUser(2, 4)
arrUser(0, 0) = "CH4"
arrUser(0, 1) = 0.7
arrUser(1, 0) = "C2H6"
arrUser(1, 1) = 0.3
'declare variables for the loop
Dim i As Long, j As Long
'loop for the first dimension
For i = LBound(arr, 1) To UBound(arr, 1)
'loop for the second dimension
For j = LBound(arr, 2) To UBound(arr, 2)
If T = 0 And arr(i, j) = "CH4" And arrUser(i, j) = "CH4" Then
LoopThroughArray = arr(i, j + 1) * x 'the X is concentration of CH4 selected by user
Else
If T = 25 And arr(i, j) = "CH4" And arrUser(i, j) = "CH4" Then
LoopThroughArray = arr(i, j + 2) * x 'the X is concentration of CH4 selected by user
End If
End If
Next j
Next i
End Function
来自 Excel 的屏幕截图： 我还附上了一张截图，显示了代码中嵌入的 table 的值，以及该函数最终如何工作。
问题：
目前，我编写的代码仅在函数用于 CH4 化合物且用户手动 select 包含浓度值的单元格（我的代码中为 x）时才有效。
我应该如何修改代码，让function/loop搜索用户输入的table，将其中的化合物名称与内置table中的化合物名称进行匹配在代码中并计算以下形式的值：浓度（用户定义，目前我的代码中的 x 值）* 特定化合物在所需温度（0 或 25 度）下的 LHV。
1.编辑： 我需要更改什么才能使函数独立于 compounds/concentrations 是不是按列输入而是按行输入？
2。编辑：
我稍微更改了代码，在化合物的内置数组中，值是通过采用函数中设置的温度“T”的多项式计算的。
一个。我已经创建了“如果”条件来通知错误输入的数据。我为此使用了 WorksheetFunction.[...] （我想知道使用此选项是否是解决问题的正确方法）。当我在另一个工作表中使用该功能时，一条消息会在满足条件时激活来自其他单元格的消息。即使我启动 excel 文件，也会弹出消息。
问题1：我应该如何更改下面的代码，以便在输入公式时（满足假定条件时）仅弹出一次消息？
b。 问题2：如何创造条件：
-当函数中输入的温度低于selected化合物的25度时，将弹出一条消息通知您（这适用于所有化合物，包括空气），
-当函数中输入的温度高于 2200 度时，selected 化合物将出现空气，将出现一条消息，通知空气温度超出范围，
-如果函数中输入的温度对于 selected 化合物高于 3000 度，则会出现一条消息，通知温度超出范围。
示例：
代码：
Public Function Cp_mix_t(T, compounds As Range, concentrations As Range) As Double
Dim arr() As Variant
Dim i As Long, j As Long, k As Long
Dim curRow As Range
Dim ret As Double, x As Double
TN=273
'Array of compounds and polynomials defining Cp
ReDim arr(29, 2)
arr(0, 0) = "CH4"
arr(0, 1) = -1.9E-14 * (T + TN) ^ 5 + 2.1E-10 * (T + TN) ^ 4 - 7.1E-07 * (T + TN) ^ 3 + 7.8E-04 * (T + TN) ^ 2 + 1.4 * (T + TN) ^ 1 + 1709.8
arr(20, 0) = "N2"
arr(20, 1) = -3.5E-15 * (T + TN) ^ 5 + 3.9E-11 * (T + TN) ^ 4 - 1.61E-07 * (T + TN) ^ 3 + 2.87E-04 * (T + TN) ^ 2 - 0.17 * (T + TN) ^ 1 + 1054.5
arr(28, 0) = "AIR"
arr(28, 1) = -9.8E-15 * (T + TN) ^ 5 + 8.4E-11 * (T + TN) ^ 4 - 2.7E-07 * (T + TN) ^ 3 + 4.1E-04 * (T + TN) ^ 2 - 0.16 * (T + TN) ^ 1 + 1027.9
concentrationHasRows = True
If concentrations.Columns.Count > 1 Then
concentrationHasRows = False
End If
For Each Cell In concentrations 'It checks if negative values of percentages in selected cells have been entered. If so, a warning appears and the program does not count Cp - it gives a value of 0
If Cell.Value < 0 Then
MsgBox ("A negative value was entered!")
Cp_mix_t = 0
Exit Function
End If
Next Cell
If compounds.Count <> concentrations.Count Then 'It checks if the number of entered compounds matches the number of entered percentages. If not, a message appears and the program does not count Cp - it gives a value of 0
MsgBox ("Wrong selection! Check the selected range of compounds/percentages.")
Cp_mix_t = 0
Exit Function
ElseIf WorksheetFunction.Sum(concentrations) > 1 Then 'It checks if the sum of percentages >100%. If so, a warning appears and the program does not count Cp - it gives a value of 0
MsgBox ("Sum of percentages greater than 100%!")
Cp_mix_t = 0
Exit Function
ElseIf WorksheetFunction.Sum(concentrations) > 0 And WorksheetFunction.Sum(concentrations) < 1 Then 'It checks if the sum of the percentages =100%. If yes, then only the message
MsgBox ("The sum of the percentages is not equal to 100%!")
End If
' Loop through user input rows:
k = 1
For Each m In compounds
arraycompound = Trim(UCase(m.Value2))
For i = 0 To UBound(arr, 1)
If arr(i, 0) = arraycompound Then
' x retrieves user's input of concentration:
If concentrationHasRows Then
x = concentrations.Cells(k, 1).Value2
Else
x = concentrations.Cells(1, k).Value2
End If
If T < 25 Then
MsgBox ("Temperature below 25 deg")
ElseIf T > 2200 And arr(i, 0) = "AIR" Then
MsgBox ("Temperature for air above 2200 deg ")
' ElseIf T > 3000 And arr(i, 0) = Not "AIR" Then
' MsgBox ("Temperature for compounds above 3000 deg")
End If
ret = ret + arr(i, j + 1) * x
Exit For
End If
Next
k = k + 1
Next
Cp_mix_t = ret
End Function
(Re-edited) 我找到了这个可能的解决方案。数据模块中的代码为：
' call the function like in =LHV(25;A9:B10;E5:E6)
Function LHV(T, compounds As Range, concentrations As Range) As Double
Dim rng1 As Range, rng2 As Range
If ThisWorkbook.done = False Then
ThisWorkbook.numMsg = 0
ThisWorkbook.done = True
For Each cell In compounds.Application.ActiveSheet.UsedRange
If cell.HasFormula Then
' change down here "LHV(" by your formula's name:
If InStr(Replace(UCase(cell.Formula), " ", ""), "LHV(") Then
v = Split(cell.Formula, ",") ' code arrives here?
pos = InStr(v(0), "(")
v(0) = Mid(v(0), pos + 1)
Set rng1 = Range(v(1))
v(2) = Replace(v(2), ")", "")
Set rng2 = Range(v(2))
cellLHV v(0), rng1, rng2
End If
End If
Next
End If
If ThisWorkbook.numMsg And 1 Then
MsgBox ("Temperature below 25 deg")
End If
If ThisWorkbook.numMsg And 2 Then
MsgBox ("Temperature for air above 2200 deg ")
End If
If ThisWorkbook.numMsg And 4 Then
' MsgBox ("Temperature for compounds above 3000 deg")
End If
If ThisWorkbook.numMsg And 8 Then
' MsgBox ("Some other message")
End If
ThisWorkbook.numMsg = 0
LHV = cellLHV(T, compounds, concentrations)
ThisWorkbook.done = False
End Function
Function cellLHV(T, compounds As Range, concentrations As Range) As Double
Dim arr() As Variant
Dim strFind As String
Dim i As Long, j As Long, k As Long
Dim curRow As Range
Dim ret As Double, x As Double
ReDim arr(2, 4)
arr(0, 0) = "CH4"
arr(0, 1) = 35.818
arr(0, 2) = 35.808
arr(1, 0) = "C2H6"
arr(1, 1) = 63.76
arr(1, 2) = 63.74
arr(2, 0) = "C3H8"
arr(2, 1) = 91.18
arr(2, 2) = 91.15
concentrationHasRows = True
If concentrations.Columns.Count > 1 Then
concentrationHasRows = False
End If
' Loop through user input rows:
k = 1
For Each m In compounds
arraycompound = Trim(UCase(m.Value2))
For i = 0 To UBound(arr, 1)
If arr(i, 0) = arraycompound Then
' x retrieves user's input of concentration:
If concentrationHasRows Then
x = concentrations.Cells(k, 1).Value2
Else
x = concentrations.Cells(1, k).Value2
End If
If T < 25 Then
ThisWorkbook.numMsg = ThisWorkbook.numMsg Or 1
ElseIf T > 2200 And arr(i, 0) = "AIR" Then
ThisWorkbook.numMsg = ThisWorkbook.numMsg Or 2
'ElseIf T > 3000 And arr(i, 0) = Not "AIR" Then
'ThisWorkbook.numMsg = ThisWorkbook.numMsg Or 4
' ElseIf ..... then
'ThisWorkbook.numMsg = ThisWorkbook.numMsg Or 8
End If
ret = ret + arr(i, j + 1) * x
Exit For
End If
Next
k = k + 1
Next
cellLHV = ret
End Function
...以及 Data 的 ThisWorkbook 中的代码：
Public numMsg As Long
Public done As Boolean
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
ThisWorkbook.done = False
End Sub
同时将 arr() 转换为全局 Public 变量速度可以提高。
如果温度 T 将成为单元格范围，则将函数更改为：
Public Function Cp_mix_t(T, compounds As Range, concentrations As Range) As Double
Dim rng1 As Range, rng2 As Range
Dim rng0 As Range
If ThisWorkbook.done = False Then
ThisWorkbook.numMsg = 0
ThisWorkbook.done = True
For Each cell In compounds.Application.ActiveSheet.UsedRange
If cell.HasFormula Then
If InStr(Replace(cell.Formula, " ", ""), "Cp_mix_t(") Then
v = Split(cell.Formula, ",")
pos = InStr(v(0), "(")
v(0) = Mid(v(0), pos + 1)
Set rng0 = Range(v(0))
Set rng1 = Range(v(1))
v(2) = Replace(v(2), ")", "")
Set rng2 = Range(v(2))
' code arrives here ?
cellCp_mix_t rng0, rng1, rng2
End If
End If
Next
End If
If ThisWorkbook.numMsg And 1 Then
MsgBox ("Temperature below 25 deg")
End If
If ThisWorkbook.numMsg And 2 Then
MsgBox ("Temperature for air above 2200 deg ")
End If
If ThisWorkbook.numMsg And 4 Then
' MsgBox ("Temperature for compounds above 3000 deg")
End If
If ThisWorkbook.numMsg And 8 Then
' MsgBox ("Some other message")
End If
ThisWorkbook.numMsg = 0
Cp_mix_t = cellCp_mix_t(T, compounds, concentrations)
ThisWorkbook.done = False
End Function