【转载】配平化学方程式

loquat · 发表于 2017-1-27 22:51

作者是百度贴吧：XiaoJSoft，季文骢，whs_jwc@163.com

网址：http://tieba.baidu.com/p/1016980941

代码结构很不错，效率上如果有人有兴趣可以优化一下
我就是在作者分享的基础上，搭梯子下载了，然后做成过程，方便调用

Sub GoBalance(ByVal strEquation As String, ByRef 配平结果 As String, ByRef 配平系数 As String)
On Error Resume Next
Dim strOut As String
Dim lpCurrent As Long
Dim bpResult As Boolean
Dim rsBalanced() As Long
Dim psSides As New Collection
Dim psSide1 As New Collection
Dim psSide2 As New Collection
strEquation = RemoveSpace(strEquation)
strEquation = ResolveStringCC(strEquation, "==", "=", "++", "+", "`", "", ".", "")
If Trim(strEquation) = vbNullString Then
MsgBox "请输入正确的化学方程式！！！"
Exit Sub
End If
bpResult = BalanceCE(strEquation, rsBalanced())
If bpResult = False Then
MsgBox "无法配平此方程式，请检查！！！"
Exit Sub
End If
ClearCollection psSides
ClearCollection psSide1
ClearCollection psSide2
ResolveCommandEX Trim(strEquation), psSides, "="
ResolveCommandEX psSides.Item(1), psSide1, "+"
ResolveCommandEX psSides.Item(2), psSide2, "+"
strOut = vbNullString
For lpCurrent = 1 To psSide1.Count
strOut = strOut & IIf(rsBalanced(lpCurrent) <> 1, Trim(Str(rsBalanced(lpCurrent))), "") & psSide1.Item(lpCurrent) & IIf(lpCurrent = psSide1.Count, "=", "+")
Next lpCurrent
For lpCurrent = 1 To psSide2.Count
strOut = strOut & IIf(rsBalanced(psSide1.Count + lpCurrent) <> 1, Trim(Str(rsBalanced(psSide1.Count + lpCurrent))), "") & psSide2.Item(lpCurrent) & IIf(lpCurrent = psSide2.Count, "", "+")
Next lpCurrent
配平结果 = strOut
strOut = vbNullString
For lpCurrent = 1 To UBound(rsBalanced())
strOut = strOut & Trim(Str(rsBalanced(lpCurrent))) & IIf(lpCurrent = UBound(rsBalanced()), "", ",")
Next lpCurrent
配平系数 = strOut
End Sub

复制代码

'调用方法，也很简单

Sub test()
Dim strEquation$, str1$, str2$
strEquation = "KMnO4=K2MnO4+MnO2+O2"
GoBalance strEquation, str1, str2
Debug.Print str1
Debug.Print str2
End Sub

复制代码

大神的代码见附件。

loquat · 发表于 2017-1-27 22:52

惯例沙发。

chuhaiou · 发表于 2017-2-19 10:58

效果图

dongdonggege · 发表于 2017-4-16 21:48

大侠，你好，我也下载了XiaoJSoft先生的化学方程式，我是从网盘下载的，见：http://club.excelhome.net/thread-1333266-1-1.html，并且经过几位大侠的改编，如http://club.excelhome.net/thread-1335619-1-1.html，八楼，感觉很不错，并且有位大侠，把分子量的计算也研究出来了，见：http://club.excelhome.net/thread-1333028-1-1.html。

loquat · 发表于 2017-4-16 22:26

dongdonggege 发表于 2017-4-16 21:48
大侠，你好，我也下载了XiaoJSoft先生的化学方程式，我是从网盘下载的，见：http://club.excelhome.net/thr ...

你们研究得很好啊。我没有深究，是有朋友想用一下。

dongdonggege · 发表于 2017-4-17 13:55

chuhaiou 发表于 2017-2-19 10:58
效果图

效果不错，我也有这个配平化学方程式程序，及方程式中让数字变下标。你这是否先变下标，再配平方程式。不然变下标，就让英文前面的数字也变下标了。两步能否变一步？变下标和配平一起来。

weiyingde · 发表于 2017-4-17 14:57

dongdonggege 发表于 2017-4-17 13:55
效果不错，我也有这个配平化学方程式程序，及方程式中让数字变下标。你这是否先变下标，再配平方程式。不 ...

这倒是个好主意，很好，期待成功，先睹为快。

weiyingde · 发表于 2017-4-17 15:02

loquat 发表于 2017-4-16 22:26
你们研究得很好啊。我没有深究，是有朋友想用一下。

不错，有学习，有借鉴，有创造。

loquat · 发表于 2017-4-18 09:51

dongdonggege 发表于 2017-4-17 13:55
效果不错，我也有这个配平化学方程式程序，及方程式中让数字变下标。你这是否先变下标，再配平方程式。不 ...

先配平再转下标

loquat · 发表于 2017-4-18 09:56

dongdonggege 发表于 2017-4-17 13:55
效果不错，我也有这个配平化学方程式程序，及方程式中让数字变下标。你这是否先变下标，再配平方程式。不 ...

先配平再转下标
用正则来做，非+号后的数组都变下标

		自动登录	找回密码
密码			免费注册

[分享] 【转载】配平化学方程式