huonglien1901
GPE là ngôi nhà thứ 2 của tôi!!!
- Tham gia
- 17/4/16
- Bài viết
- 2,702
- Được thích
- 2,434
- Giới tính
- Nam
- Nghề nghiệp
- Nhân viên kỹ thuật in ấn
đây là hóa vô cơ thôi Bác, em tập làm thử dạng này.Gặp hoá hữu nó dài thòng thì bỏ mạng.
Bài này có thể phải giải bằng cách parse string. Kỹ thuật của trình dịch dùng để duyệt biểu thức.
Option Explicit
Function KLPT(ByVal s As String) As Double
Static dic As Dictionary
Dim arr(), i As Long, n As Long, tmp As String, ThisChar As String, LastChar As String
If dic Is Nothing Then
arr = Range("D2:E" & Range("E2").End(xlDown).Row)
Set dic = New Dictionary
dic.CompareMode = BinaryCompare
For i = 1 To UBound(arr)
dic.Item(arr(i, 1)) = arr(i, 2)
Next
End If
n = Len(s)
i = 1
Do While i <= n
ThisChar = Mid(s, i, 1)
If ThisChar = "(" Then
tmp = tmp & "+" & ThisChar
ElseIf ThisChar = ")" Then
tmp = tmp & ThisChar
ElseIf IsNumeric(ThisChar) Then
If IsNumeric(LastChar) Then
tmp = tmp & ThisChar
Else
tmp = tmp & "*" & ThisChar
End If
Else
If dic.Exists(ThisChar & Mid(s, i + 1, 1)) Then
tmp = tmp & "+" & dic.Item(ThisChar & Mid(s, i + 1, 1))
i = i + 1
Else
tmp = tmp & "+" & dic.Item(ThisChar)
End If
End If
i = i + 1
LastChar = ThisChar
Loop
tmp = Right(tmp, Len(tmp) - 1)
KLPT = Evaluate(tmp)
End Function
Mấy năm về trước học được từ bác cái Reg này DHN46 cũng đã làm 1 bài làm công thức hóa học tương tự. Nay nhìn lại thấy quên nhiều quá rồi ^^Bạn xem và kiểm tra kỹ vì tôi chưa suy nghĩ sâu lắm. Chủ yếu là tôi không dám chắc 100% là pattern chuẩn (tôi dùng RegExp).
Bạn nên kiểm tra những công thức thật sự phức tạp. Kiểu như CH3(C3H4(NH2)2)18CH3
Lưu ý:
1. Chỉ được dùng dấu ngoặc duy nhất là ( và ). Không chấp nhận {, }, [, ]
2. Nếu dùng ngoặc thì phải có số sau ký tự ")".
Tức không chấp nhận NH4[Co(NH3)2(NO2)4] do dùng dấu ngoặc [, ]
và không chấp nhận NH4(Co(NH3)2(NO2)4) do sau dấu ngoặc ")" cuối cùng không có số.
Chỉ chấp nhận NH4Co(NH3)2(NO2)4
Vợ chồng bạn giãn cách xã hội tốt chứ? Cố gắng nhé.Mấy năm về trước học được từ bác cái Reg này DHN46 cũng đã làm 1 bài làm công thức hóa học tương tự. Nay nhìn lại thấy quên nhiều quá rồi ^^
Function CalChemical(ByVal Expression As String) As Double
Expression = VBA.Replace(Expression, " ", "")
Dim D As Object
Set D = ChemicalsD
Dim i As Long, L As Long, T As String, W As String, LW As String
i = 1: L = Len(Expression)
Do While i <= L
W = VBA.Mid(Expression, i, 1)
Select Case True
Case W = "(": T = T & "+("
Case W = ")": T = T & ")"
Case VBA.IsNumeric(W): T = T & VBA.IIf(VBA.IsNumeric(LW), "", "*") & W
Case Else
If D.Exists(VBA.Mid(Expression, i, 2)) Then
T = T & "+" & D.Item(VBA.Mid(Expression, i, 2))
i = i + 1
Else
T = T & "+" & D.Item(W)
End If
End Select
i = i + 1: LW = W
Loop
CalChemical = Application.Evaluate(T)
End Function
Function CalChemical2(Expression As String)
Expression = VBA.Replace(Expression, " ", "")
Dim a, i, s As String
a = Chemicals: s = Expression
With VBA.CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "(\d+)": s = .Replace(s, "*$1")
.Pattern = "([A-Z][a-z]?)([\(A-Z][a-z]?)": s = .Replace(s, "$1+$2")
.Pattern = "(\d+)([\(A-Z])": s = .Replace(s, "$1+$2")
End With
For i = UBound(a) To 1 Step -1
s = VBA.Replace(s, a(i, 1), CStr(a(i, 2)))
Next
CalChemical2 = Application.Evaluate(s)
End Function
Function ChemicalsD() As Object
Static Dict As Object
If Dict Is Nothing Then
Set Dict = VBA.CreateObject("Scripting.Dictionary")
Dict("Ac") = 227
Dict("Ag") = 107.8682
Dict("Al") = 26.9815
Dict("Am") = 243
Dict("Ar") = 39.948
Dict("As") = 74.9216
Dict("At") = 210
Dict("Au") = 196.9665
Dict("B") = 10.811
Dict("Ba") = 137.327
Dict("Be") = 9.0122
Dict("Bh") = 264
Dict("Bi") = 208.9804
Dict("Bk") = 247
Dict("Br") = 79.904
Dict("C") = 12.0107
Dict("Ca") = 40.078
Dict("Cd") = 112.411
Dict("Ce") = 140.116
Dict("Cf") = 251
Dict("Cl") = 35.453
Dict("Cm") = 247
Dict("Co") = 58.9332
Dict("Cr") = 51.9961
Dict("Cs") = 132.9055
Dict("Cu") = 63.546
Dict("Db") = 262
Dict("Dy") = 162.5
Dict("Er") = 167.259
Dict("Es") = 252
Dict("Eu") = 151.964
Dict("F") = 18.9984
Dict("Fe") = 55.845
Dict("Fm") = 257
Dict("Fr") = 223
Dict("Ga") = 69.723
Dict("Gd") = 157.25
Dict("Ge") = 72.64
Dict("H") = 1.0079
Dict("He") = 4.0026
Dict("Hf") = 178.49
Dict("Hg") = 200.59
Dict("Ho") = 164.9303
Dict("Hs") = 277
Dict("I") = 126.9045
Dict("In") = 114.818
Dict("Ir") = 192.217
Dict("K") = 39.0983
Dict("Kr") = 83.8
Dict("La") = 138.9055
Dict("Li") = 6.941
Dict("Lr") = 262
Dict("Lu") = 174.967
Dict("Md") = 258
Dict("Mg") = 24.305
Dict("Mn") = 54.938
Dict("Mo") = 95.94
Dict("Mt") = 268
Dict("N") = 14.0067
Dict("Na") = 22.9897
Dict("Nb") = 92.9064
Dict("Nd") = 144.24
Dict("Ne") = 20.1797
Dict("Ni") = 58.6934
Dict("No") = 259
Dict("Np") = 237
Dict("O") = 15.9994
Dict("Os") = 190.23
Dict("P") = 30.9738
Dict("Pa") = 231.0359
Dict("Pb") = 207.2
Dict("Pd") = 106.42
Dict("Pm") = 145
Dict("Po") = 209
Dict("Pr") = 140.9077
Dict("Pt") = 195.078
Dict("Pu") = 244
Dict("Ra") = 226
Dict("Rb") = 85.4678
Dict("Re") = 186.207
Dict("Rf") = 261
Dict("Rh") = 102.9055
Dict("Rn") = 222
Dict("Ru") = 101.07
Dict("S") = 32.065
Dict("Sb") = 121.76
Dict("Sc") = 44.9559
Dict("Se") = 78.96
Dict("Sg") = 266
Dict("Si") = 28.0855
Dict("Sm") = 150.36
Dict("Sn") = 118.71
Dict("Sr") = 87.62
Dict("Ta") = 180.9479
Dict("Tb") = 158.9253
Dict("Tc") = 98
Dict("Te") = 127.6
Dict("Th") = 232.0381
Dict("Ti") = 47.867
Dict("Tl") = 204.3833
Dict("Tm") = 168.9342
Dict("U") = 238.0289
Dict("V") = 50.9415
Dict("W") = 183.84
Dict("Xe") = 131.293
Dict("Y") = 88.9059
Dict("Yb") = 173.04
End If
Set ChemicalsD = Dict
End Function
Function Chemicals() As Variant
Dim a(1 To 109, 1 To 2)
a(1, 1) = "B": a(1, 2) = 10.811
a(2, 1) = "C": a(2, 2) = 12.0107
a(3, 1) = "F": a(3, 2) = 18.9984
a(4, 1) = "H": a(4, 2) = 1.0079
a(5, 1) = "I": a(5, 2) = 126.9045
a(6, 1) = "K": a(6, 2) = 39.0983
a(7, 1) = "N": a(7, 2) = 14.0067
a(8, 1) = "O": a(8, 2) = 15.9994
a(9, 1) = "P": a(9, 2) = 30.9738
a(10, 1) = "S": a(10, 2) = 32.065
a(11, 1) = "U": a(11, 2) = 238.0289
a(12, 1) = "V": a(12, 2) = 50.9415
a(13, 1) = "W": a(13, 2) = 183.84
a(14, 1) = "Y": a(14, 2) = 88.9059
a(15, 1) = "Ac": a(15, 2) = 227
a(16, 1) = "Ag": a(16, 2) = 107.8682
a(17, 1) = "Al": a(17, 2) = 26.9815
a(18, 1) = "Am": a(18, 2) = 243
a(19, 1) = "Ar": a(19, 2) = 39.948
a(20, 1) = "As": a(20, 2) = 74.9216
a(21, 1) = "At": a(21, 2) = 210
a(22, 1) = "Au": a(22, 2) = 196.9665
a(23, 1) = "Ba": a(23, 2) = 137.327
a(24, 1) = "Be": a(24, 2) = 9.0122
a(25, 1) = "Bh": a(25, 2) = 264
a(26, 1) = "Bi": a(26, 2) = 208.9804
a(27, 1) = "Bk": a(27, 2) = 247
a(28, 1) = "Br": a(28, 2) = 79.904
a(29, 1) = "Ca": a(29, 2) = 40.078
a(30, 1) = "Cd": a(30, 2) = 112.411
a(31, 1) = "Ce": a(31, 2) = 140.116
a(32, 1) = "Cf": a(32, 2) = 251
a(33, 1) = "Cl": a(33, 2) = 35.453
a(34, 1) = "Cm": a(34, 2) = 247
a(35, 1) = "Co": a(35, 2) = 58.9332
a(36, 1) = "Cr": a(36, 2) = 51.9961
a(37, 1) = "Cs": a(37, 2) = 132.9055
a(38, 1) = "Cu": a(38, 2) = 63.546
a(39, 1) = "Db": a(39, 2) = 262
a(40, 1) = "Dy": a(40, 2) = 162.5
a(41, 1) = "Er": a(41, 2) = 167.259
a(42, 1) = "Es": a(42, 2) = 252
a(43, 1) = "Eu": a(43, 2) = 151.964
a(44, 1) = "Fe": a(44, 2) = 55.845
a(45, 1) = "Fm": a(45, 2) = 257
a(46, 1) = "Fr": a(46, 2) = 223
a(47, 1) = "Ga": a(47, 2) = 69.723
a(48, 1) = "Gd": a(48, 2) = 157.25
a(49, 1) = "Ge": a(49, 2) = 72.64
a(50, 1) = "He": a(50, 2) = 4.0026
a(51, 1) = "Hf": a(51, 2) = 178.49
a(52, 1) = "Hg": a(52, 2) = 200.59
a(53, 1) = "Ho": a(53, 2) = 164.9303
a(54, 1) = "Hs": a(54, 2) = 277
a(55, 1) = "In": a(55, 2) = 114.818
a(56, 1) = "Ir": a(56, 2) = 192.217
a(57, 1) = "Kr": a(57, 2) = 83.8
a(58, 1) = "La": a(58, 2) = 138.9055
a(59, 1) = "Li": a(59, 2) = 6.941
a(60, 1) = "Lr": a(60, 2) = 262
a(61, 1) = "Lu": a(61, 2) = 174.967
a(62, 1) = "Md": a(62, 2) = 258
a(63, 1) = "Mg": a(63, 2) = 24.305
a(64, 1) = "Mn": a(64, 2) = 54.938
a(65, 1) = "Mo": a(65, 2) = 95.94
a(66, 1) = "Mt": a(66, 2) = 268
a(67, 1) = "Na": a(67, 2) = 22.9897
a(68, 1) = "Nb": a(68, 2) = 92.9064
a(69, 1) = "Nd": a(69, 2) = 144.24
a(70, 1) = "Ne": a(70, 2) = 20.1797
a(71, 1) = "Ni": a(71, 2) = 58.6934
a(72, 1) = "No": a(72, 2) = 259
a(73, 1) = "Np": a(73, 2) = 237
a(74, 1) = "Os": a(74, 2) = 190.23
a(75, 1) = "Pa": a(75, 2) = 231.0359
a(76, 1) = "Pb": a(76, 2) = 207.2
a(77, 1) = "Pd": a(77, 2) = 106.42
a(78, 1) = "Pm": a(78, 2) = 145
a(79, 1) = "Po": a(79, 2) = 209
a(80, 1) = "Pr": a(80, 2) = 140.9077
a(81, 1) = "Pt": a(81, 2) = 195.078
a(82, 1) = "Pu": a(82, 2) = 244
a(83, 1) = "Ra": a(83, 2) = 226
a(84, 1) = "Rb": a(84, 2) = 85.4678
a(85, 1) = "Re": a(85, 2) = 186.207
a(86, 1) = "Rf": a(86, 2) = 261
a(87, 1) = "Rh": a(87, 2) = 102.9055
a(88, 1) = "Rn": a(88, 2) = 222
a(89, 1) = "Ru": a(89, 2) = 101.07
a(90, 1) = "Sb": a(90, 2) = 121.76
a(91, 1) = "Sc": a(91, 2) = 44.9559
a(92, 1) = "Se": a(92, 2) = 78.96
a(93, 1) = "Sg": a(93, 2) = 266
a(94, 1) = "Si": a(94, 2) = 28.0855
a(95, 1) = "Sm": a(95, 2) = 150.36
a(96, 1) = "Sn": a(96, 2) = 118.71
a(97, 1) = "Sr": a(97, 2) = 87.62
a(98, 1) = "Ta": a(98, 2) = 180.9479
a(99, 1) = "Tb": a(99, 2) = 158.9253
a(100, 1) = "Tc": a(100, 2) = 98
a(101, 1) = "Te": a(101, 2) = 127.6
a(102, 1) = "Th": a(102, 2) = 232.0381
a(103, 1) = "Ti": a(103, 2) = 47.867
a(104, 1) = "Tl": a(104, 2) = 204.3833
a(105, 1) = "Tm": a(105, 2) = 168.9342
a(106, 1) = "Xe": a(106, 2) = 131.293
a(107, 1) = "Yb": a(107, 2) = 173.04
a(108, 1) = "Zn": a(108, 2) = 65.39
a(109, 1) = "Zr": a(109, 2) = 91.224
Chemicals = a
End Function
Thấy mấy bài dùng regexp là ngứa tay, góp vui chung, dùng cách Evaluate của bạn Hau151978Em chào mọi người!
Em có vấn đề nhờ mọi người hỗ trợ.
Em muốn tính tổng cộng trọng lượng của 01 công thức hóa học.
Bài này mọi người có thể giúp em công thức hoặc VBA đều được, em muốn học hỏi thêm.
Em cảm ơn mọi người nhiều!
Function ssum(ByVal str As String, ByVal rng1 As Range, ByVal rng2 As Range)
Dim arr, arr2, sptn As String
arr = Application.Transpose(rng1)
arr2 = Application.Transpose(rng2)
sptn = Join(arr, "|")
With CreateObject("vbscript.regexp")
.Global = True
str = Replace(Replace(str, ")", ")*"), "(", "+(")
.Pattern = "((?:" & sptn & ")\d*|\d)(?=" & sptn & ")"
str = .Replace(str, "$1+")
.Pattern = "(" & sptn & ")(?=\d)"
str = .Replace(str, "$1*")
.Pattern = "(" & sptn & ")(?=\*|\+|\))"
str = .Replace(str & "+0", "|$1|")
End With
For i = 1 To UBound(arr)
str = Replace(str, "|" & arr(i) & "|", arr2(i))
Next
ssum = Evaluate(str)
End Function
Không ngờ có người làm được bằng công thức luôn đấy.Chào mọi người!
Trong file em có 01 công thức mảng, em đọc mà trừu tượng quá(trong công thức có 3 name):
Name 1: Arr: =ROW(INDEX(Sheet1!$A:$A,1):INDEX(Sheet1!$A:$A,LEN(Sheet1!$A2)))
Name 2: Sym:=Sheet1!$F$2:$F$110
Name 3: Wgt: =Sheet1!$G$2:$G$110
Toàn bộ công thức như sau:
=SUM(SUMIF(Sym,MID(A2,Arr,MMULT(0+(ABS({77.5,107.5}-CODE(MID(MID(A2&"ζ",Arr,2),{1,2},1)))<13),{1;1})),Wgt)*IFERROR(0+MID(A2,MMULT(0+(ABS({77.5,107.5}-CODE(MID(MID(A2&"ζ",Arr,2),{1,2},1)))<13),{1;1})+Arr,MMULT(1-ISERR(0+MID(A2,Arr+MMULT(0+(ABS({77.5,107.5}-CODE(MID(MID(A2&"ζ",Arr,2),{1,2},1)))<13),{1;1}),{1,2})),{1;1})),1)*IFERROR(0+MID(A2,IF(ISNUMBER(MATCH(Arr,IF(ISODD(MATCH(Arr,MODE.MULT(IF(MID(A2,Arr,1)={"(",")"},Arr+{1,0}),Arr))),Arr),0)),FIND(")",A2,Arr))+1,MMULT(1-ISERR(0+MID(A2,IF(ISNUMBER(MATCH(Arr,IF(ISODD(MATCH(Arr,MODE.MULT(IF(MID(A2,Arr,1)={"(",")"},Arr+{1,0}),Arr))),Arr),0)),FIND(")",A2,Arr))+1,{1,2})),{1;1})),1))
Đây là công thức mảng: Nhớ nhấn CTRL+SHIFT+ENTER.
Mà công thức này bị sai ở hợp chất này:CH3(C3H4(NH2)2)18CH3
Kết quả sai: 126.2187
Kết quả đúng: 1328.0254
Em nhờ mọi người xem file hỗ trợ điều chỉnh công thức này:
Em cảm ơn cả nhà nhiều!
Lười thay đổi hàm nên làm đại với công thức cũ, điểm yếu sử dụng hàm CONCAT từ excel 2016 trờ lên và sử dụng hàm Evaluate nên phải lưu ở dạng XLSB hoặc XLSM:Chào mọi người!
Trong file em có 01 công thức mảng, em đọc mà trừu tượng quá(trong công thức có 3 name):
Name 1: Arr: =ROW(INDEX(Sheet1!$A:$A,1):INDEX(Sheet1!$A:$A,LEN(Sheet1!$A2)))
Name 2: Sym:=Sheet1!$F$2:$F$110
Name 3: Wgt: =Sheet1!$G$2:$G$110
Toàn bộ công thức như sau:
=SUM(SUMIF(Sym,MID(A2,Arr,MMULT(0+(ABS({77.5,107.5}-CODE(MID(MID(A2&"ζ",Arr,2),{1,2},1)))<13),{1;1})),Wgt)*IFERROR(0+MID(A2,MMULT(0+(ABS({77.5,107.5}-CODE(MID(MID(A2&"ζ",Arr,2),{1,2},1)))<13),{1;1})+Arr,MMULT(1-ISERR(0+MID(A2,Arr+MMULT(0+(ABS({77.5,107.5}-CODE(MID(MID(A2&"ζ",Arr,2),{1,2},1)))<13),{1;1}),{1,2})),{1;1})),1)*IFERROR(0+MID(A2,IF(ISNUMBER(MATCH(Arr,IF(ISODD(MATCH(Arr,MODE.MULT(IF(MID(A2,Arr,1)={"(",")"},Arr+{1,0}),Arr))),Arr),0)),FIND(")",A2,Arr))+1,MMULT(1-ISERR(0+MID(A2,IF(ISNUMBER(MATCH(Arr,IF(ISODD(MATCH(Arr,MODE.MULT(IF(MID(A2,Arr,1)={"(",")"},Arr+{1,0}),Arr))),Arr),0)),FIND(")",A2,Arr))+1,{1,2})),{1;1})),1))
Đây là công thức mảng: Nhớ nhấn CTRL+SHIFT+ENTER.
Mà công thức này bị sai ở hợp chất này:CH3(C3H4(NH2)2)18CH3
Kết quả sai: 126.2187
Kết quả đúng: 1328.0254
Em nhờ mọi người xem file hỗ trợ điều chỉnh công thức này:
Em cảm ơn cả nhà nhiều!
Dạng nầy quá phức tạp mình bó tay@HieuCD @Phan Thế Hiệp các anh có cách nào giải bằng hàm không nhỉ, em nghiên cứu mấy bữa mà vẫn chưa có câu trả lời![]()
Có công thức sẵn đó anh chỉ là chưa hoàn thiện. Xác định ngoặc nào trong ngoặc nào và lấy số nhân áp vào khá khó. Nếu nhiều ngoặc thì công thức siêu dài. Với không có hàm nhân mảng với mảng giống hàm MMULT(...,{1;1...})Dạng nầy quá phức tạp mình bó tay![]()
Gặp mấy hàm mảng phức tạp là mình ớn lạnh không có ý tưởng gìCó công thức sẵn đó anh chỉ là chưa hoàn thiện. Xác định ngoặc nào trong ngoặc nào và lấy số nhân áp vào khá khó. Nếu nhiều ngoặc thì công thức siêu dài. Với không có hàm nhân mảng với mảng giống hàm MMULT(...,{1;1...})
Vậy đợi mấy bác kia mà em nghĩ ít có người quan tâmGặp mấy hàm mảng phức tạp là mình ớn lạnh không có ý tưởng gì![]()