Excel, Таблица Менделеева - VBA
Формулировка задачи:
Подскажите, пожалуйста, каким образом можно реализовать такую идею:
Составляем в Excel всю таблицу Менделеева. Программа должна понимать, что в Al2(SO4)3 - нужно все элементы нужно всё, что в скобках умножать на 3, а атомов серы в скобке - 1, а не ноль.
Когда программа будет составлена, должна быть возможность ввести в строке формул =M(Al2(SO4)3) - и Excel будет подсчитывать молярную массу вещества заданной формулы. Но если ввести ПР( BaSO4) - то будет выводиться растворимость, а не молярная масса этого вещества. Реально ли осуществить такое? Если нет, то хотя бы частично помогите реализовать такую идею=)
Решение задачи: «Excel, Таблица Менделеева»
textual
Листинг программы
Function MolMassa(ByVal strFormula As String) As Double
Dim i%, j%, k%, El, eM, S$, S1$, S2$, SubSum#(), OldEM#, OldEM2#, ReCalc As Boolean, LenFormula%, Chislo$, dic
El = Split("Ac Ag Al Am Ar As At Au Ba Be Bi Bk Br Ca Cd Ce Cf Cl Cm Co Cr Cs Cu Dy Er Es Eu Fe Fm Fr Ga Gd Ge He Hf Hg Ho In Ir Kr La Li Lr Lu Md Mg Mn Mo Na Nb Nd Ne Ni No Np Os Pa Pb Pd Pm Po Pr Pt Pu Ra Rb Re Rh Rn Ru Sb Sc Se Si Sm Sn Sr Ta Tb Tc Te Th Ti Tl Tm Xe Yb Zn Zr B C F H I K N O P S U V W Y")
eM = Array(227.028, 107.868, 26.982, 243.061, 39.948, 74.922, 209.987, 196.967, 137.33, 9.012, 208.98, 247.07, 79.904, 40.078, 112.41, 140.12, 251.08, 35.453, 247.07, 58.933, 51.996, 132.905, 63.546, 162.5, 167.26, 252.083, 151.96, 55.847, 257.095, 223.02, 69.723, 157.25, 72.59, 4.003, 178.49, 200.59, 164.93, 114.82, 192.22, 83.8, 138.906, 6.941, 260.105, 174.967, 258.099, 24.305, 54.938, 95.94, 22.99, 92.906, 144.24, 20.179, 58.69, 259.101, 237.048, 190.2, 231.036, 207.2, 106.42, 144.913, 208.982, 140.908, 195.08, 244.064, 226.025, 85.468, 186.207, 102.906, 222.018, 101.07, 121.75, 44.956, 78.96, 28.086, 150.36, 118.71, 87.62, 180.948, 158.925, 97.907, 127.6, 232.038, 47.88, 204.383, 168.934, 131.29, 173.04, 65.39, 91.224, 10.811, 12.011, 18.998, 1.008, 126.905, 39.098, 14.007, 15.999, 30.974, 32.066, 238.029, 50.942, 183.85, 88.906)
strFormula = strFormula & "#"
LenFormula = Len(strFormula)
ReDim SubSum(1)
Set dic = CreateObject("Scripting.Dictionary")
For j = 0 To UBound(El)
dic(El(j)) = eM(j)
Next j
k = 1
i = 1
Do
S1 = Mid(strFormula, i, 1)
ReCalc = True
OldEM2 = OldEM
Select Case S1
Case "("
Case ")", "#"
Case "0" To "9"
Chislo = Chislo & S1
ReCalc = False
Case Else
S2 = Mid(strFormula, i, 2)
S = ""
If dic.Exists(S2) Then
S = S2
ElseIf dic.Exists(S1) Then
S = S1
End If
If S <> "" Then
OldEM = dic(S)
i = i - 1 + Len(S)
End If
End Select
If ReCalc Then
If Chislo = "" Then Chislo = "1"
SubSum(k) = SubSum(k) + OldEM2 * Val(Chislo)
Chislo = ""
End If
Select Case S1
Case "("
OldEM = 0
k = k + 1
ReDim Preserve SubSum(k)
SubSum(k) = 0
Case ")"
OldEM = SubSum(k)
k = k - 1
End Select
i = i + 1
Loop While i <= LenFormula
MolMassa = SubSum(1)
Set dic = Nothing
End Function
Sub Test_MolMassa()
Debug.Print "H", MolMassa("H")
Debug.Print "O", MolMassa("O")
Debug.Print "H2O", MolMassa("H2O")
Debug.Print "S", MolMassa("S")
Debug.Print "Al2", MolMassa("Al2")
Debug.Print "SO4", MolMassa("SO4")
Debug.Print "(SO4)3", MolMassa("(SO4)3")
Debug.Print "Al2(SO4)3", MolMassa("Al2(SO4)3")
Debug.Print "H2(SO4)3", MolMassa("H2(SO4)3")
Debug.Print "(CH3)3", MolMassa("(CH3)3")
Debug.Print "(CH3)3N", MolMassa("(CH3)3N")
Debug.Print "((CH3)3N)2", MolMassa("((CH3)3N)2")
End Sub