化学式の分解② つづいた

chemiphys.hateblo.jp
さて，昨日とりあえずそれっぽい形にしたものの，スマートではないよなぁとは思っていました。

すると，このようなご指摘をいただきました。

id:imihito
上付き下付きなどの書式を維持して文字を操作したい場合は、Runsで分解したTextRangeに対して操作するとうまくいくと思います。

私の場合だと、思考停止して正規表現でやってしまうかもです。
Sub RegExpText()

Const ChkTxt$ = "10Na2HC4O3"

Dim matchCol As Object 'As VBScript_RegExp_55.MatchCollection
With VBA.CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "([0-9]+|[A-Z][a-z]?)"
Set matchCol = .Execute(ChkTxt) '←中身確認
Stop
End With

End Sub

正規表現どこかで聞いたことはあります。でも，私が知らない領域。

書いてもらったコードを動かしてみると確かにすごい。どんどん分けてくれている。

ふむふむ　すごいなぁ。。じゃ，利用させてもらって，さらに ()がつくメンドクサイ化学式もがんばってみよう。

Cu(NO3)2みたいにめんどくさいやつです。

括弧をどうにかしてやろうとか思わなければ，比較的簡単でしたが，括弧の処理は，けっこう私の手に余る内容でした。

ただ，Powerpoint VBAでデータを多数扱おうとするなら配列は便利なものですし，配列でなんかごちゃごちゃやってるなぁというのを見るだけでも，

何かのきっかけになるかもなぁと　形になっただけで，きちんとは考えられていないものですが載せてみます。

形にするだけでも，苦戦しました(;´▽｀A``

スライド１にTableという表を入れていただいて，一番上の行に化学式を入れます。

そして，下記のコードを実行してみると，表が図のようにうまる・・はず。

正規表現部分は一応ネットで調べたものの，まだ私はわかっていません。

imihitoさんに教えていただいたものをちょこっとだけいじって ( と　) も出力するように変えただけです。

Option Explicit

Sub RegExpText()
Dim TSlide As Slide: Set TSlide = ActivePresentation.Slides(1)
Dim tblChemicals As Table: Set tblChemicals = TSlide.Shapes("Table").Table

Dim ChkTxt As String
Dim colChemicals As Collection
Dim matchCol As Variant 
Dim i As Long, j As Long, k As Long, l As Long
Dim 係数 As Long, 括弧 As Long
Dim buf(0 To 10, 1 To 3) As String
Dim Chem(1 To 10) As Variant
For i = 1 To tblChemicals.Columns.Count
    ChkTxt = tblChemicals.Cell(1, i).Shape.TextFrame.TextRange
    
    With VBA.CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "([0-9]+|[A-Z][a-z]?)|\(|\)"
        Set matchCol = .Execute(ChkTxt)
    End With
    If IsNumeric(matchCol(0)) = True Then
        係数 = matchCol(0)
        j = 1
    Else
        係数 = 1
        j = 0
    End If
    buf(0, 1) = 係数
    
    k = 1
    括弧 = 1
    Do
        If matchCol(j) = "" Then Exit Do
        If matchCol(j) = "(" Then
            l = 0
            Do
            l = l + 1
            Loop Until matchCol(j + l) = ")"
            括弧 = matchCol(j + l + 1)
            
        ElseIf matchCol(j) = ")" Then
            括弧 = 1
            j = j + 1
        ElseIf IsNumeric(matchCol(j)) = False Then
            buf(k, 1) = matchCol(j)
            If j = matchCol.Count - 1 Then
                buf(k, 2) = "1"
                buf(k, 3) = 括弧
            ElseIf IsNumeric(matchCol(j + 1)) = False Then
                buf(k, 2) = "1"
                buf(k, 3) = 括弧
            End If
        ElseIf IsNumeric(matchCol(j)) = True Then
            buf(k, 2) = matchCol(j)
            buf(k, 3) = 括弧
        Else
            Debug.Print j; " "; k; " "; matchCol(j)
        End If
        
        If buf(k, 2) <> "" Then k = k + 1
        j = j + 1
    Loop Until j = matchCol.Count
            
    
Chem(i) = buf
Erase buf
Next

For i = 1 To tblChemicals.Columns.Count
    tblChemicals.Cell(2, i).Shape.TextFrame.TextRange = "係数" & Chem(i)(0, 1)
    j = 1
    Do While Chem(i)(j, 1) <> ""
        tblChemicals.Cell(j + 2, i).Shape.TextFrame.TextRange.Text = Chem(i)(j, 1) & " " & CLng(Chem(i)(j, 2)) * CLng(Chem(i)(j, 3)) & "個"
        j = j + 1
    Loop
Next
End Sub

これをスマートに書けたら，何かで使えるかもしれないんだけどなぁ。

先は長いね（ΦωΦ）