Runsメソッドを使って下付き文字を復元

imihitoさんとのコメントのやりとり，TextRange.RunsメソッドとTextRange2.Runsプロパティ:パワーポイントマクロ・PowerPoint VBAの使い方-TextFrame・TextRangeの記事を参考にさせてもらってたらなんとなくイメージが固まってきたので，上付き文字はとりあえず後回しにして，下付き文字をRunsメソッドでやってみようと考えてみました。

雑に作って見直しはしてないんですが，けっこうさくっと動いてくれた。

テキストを結合していって，結合したものに下付き等をきちんと適用できるというのが，わたしの目標なので　二つの文字列を結合してみます。
ちゃんと結合してくれていますし，なんとなくシンプルにできていきそうな感じでした。
コードはこちら

Option Explicit

Sub ss()
    Dim TSlide As Slide: Set TSlide = ActivePresentation.Slides(1)
    Dim tRng(1 To 2) As TextRange
    Dim subRng(1 To 2) As TextRange
    Dim resultRng As TextRange: Set resultRng = TSlide.Shapes("Result").TextFrame.TextRange
    Dim resultTxtRng As TextRange: Set resultTxtRng = TSlide.Shapes("ResultTxt").TextFrame.TextRange
    Dim tmptrng As TextRange
    Dim i As Long
    
    For i = 1 To 2
        Set tRng(i) = TSlide.Shapes("txt" & i).TextFrame.TextRange
        Set subRng(i) = TSlide.Shapes("Sub" & i).TextFrame.TextRange
        subRng(i) = ""
    Next
    
    resultRng = ""
    Dim LenR As Long
    For i = 1 To 2
        If i = 1 Then LenR = 0 Else LenR = Len(tRng(i - 1))
        For Each tmptrng In tRng(i).Runs
            If tmptrng.Font.Subscript = msoTrue Then
                subRng(i).Text = subRng(i).Text & tmptrng.Start + LenR & "," & tmptrng.Length & ":"
            End If
        Next
        If subRng(i) <> "" Then
            subRng(i).Text = Left(subRng(i), Len(subRng(i)) - 1)
            resultRng = resultRng & ":" & subRng(i)
        End If
    Next
    resultRng = Mid(resultRng, 2)
    resultTxtRng = ""
    
    Dim Substart As Long, Sublength As Long, strSp As String
    For i = 1 To 2
        resultTxtRng = resultTxtRng & tRng(i)
    Next
    
    For i = 0 To UBound(Split(resultRng, ":"))
        strSp = Split(resultRng, ":")(i)
        Substart = Split(strSp, ",")(0)
        Sublength = Split(strSp, ",")(1)
        resultTxtRng.Characters(Substart, Sublength).Font.Subscript = msoTrue
    Next
End Sub

for eachが使えるのが個人的にはうれしい。ひとつ前のテキストの文字数を次の文字列のSubScriptの位置に足すということをしています。
簡単に繰り返し処理が書けそう。
理解が進んだ気がします(ﾟ▽ﾟ*)

追記
コメントでcharactersに関しても大好きな For eachが使えると教えていただいたのでやってみました。
ほぼ上のコードと同じですが，lengthの扱いをしなくて済むのでこっちがシンプルですね。charactersもTextRangeを返すという極めて適切なアドバイスが，ほんとにありがたい。
imihitoさん感謝。。

ただ，上のコードも多重Splitで遊んでいて，複雑になっていますがけっこう好きなんです。その備忘録になりますね。(ﾟ▽ﾟ*)

Sub ss()
    Dim TSlide As Slide: Set TSlide = ActivePresentation.Slides(1)
    Dim trng(1 To 2) As TextRange
    Dim subRng(1 To 2) As TextRange
    Dim resultRng As TextRange: Set resultRng = TSlide.Shapes("Result").TextFrame.TextRange
    Dim resultTxtRng As TextRange: Set resultTxtRng = TSlide.Shapes("ResultTxt").TextFrame.TextRange
    Dim tmpTRng As TextRange
    Dim i As Long
    
    For i = 1 To 2
        Set trng(i) = TSlide.Shapes("txt" & i).TextFrame.TextRange
        Set subRng(i) = TSlide.Shapes("Sub" & i).TextFrame.TextRange
        subRng(i) = ""
    Next
    
    resultRng = ""
    Dim LenR As Long
    For i = 1 To 2
        If i = 1 Then LenR = 0 Else LenR = Len(trng(i - 1))
        For Each tmpTRng In trng(i).Characters
            If tmpTRng.Font.Subscript = msoTrue Then
                subRng(i).Text = subRng(i).Text & tmpTRng.Start + LenR & ","
            End If
        Next
        If subRng(i) <> "" Then
            subRng(i).Text = Left(subRng(i), Len(subRng(i)) - 1)
            resultRng = resultRng & "," & subRng(i)
        End If
    Next
    resultRng = Mid(resultRng, 2)
    resultTxtRng = ""
    
    For i = 1 To 2
        resultTxtRng = resultTxtRng & trng(i)
    Next
    
    For i = 0 To UBound(Split(resultRng, ","))
        resultTxtRng.Characters(Split(resultRng, ",")(i)).Font.Subscript = msoTrue
    Next
End Sub