VBA 上付き、下付き文字の判定

いつもお世話になります

今、日本語から英文への文字置き換えをしているのですが
英文に日本語文の中にある上付き文字記号を加えると上付き文字にならないので
苦労しています（ｍ２：mの2乗）

そこで上付き文字を見つけて環境依存文字のしたいので下記のように判定を掛けましたが
エラーが出て上手く行きません

　　　If Cells(1, 1).Character(9, 1).Font.Superscript = True Then
　　　テストプログラムで9番目の文字を上付き文字にしています

そこでご相談ですが
セル内の文字の中にある上付き文字を判定したいのですが、その方法についてお分かりでしたら教えてください

以上、よろしくお願い申し上げます

No.1 ベストアンサー 回答者： Zincer 回答日時： 2018/10/02 12:13

Character(9, 1)ではなく

Characters(9, 1)
ではないですか。

この回答へのお礼

すみません、ありがとうございます
上手く行きました

本当に恥ずかしい！

お礼日時：2018/10/02 13:42

No.2 回答者： WindFaller 回答日時： 2018/10/03 01:54

お久しぶりです。

いつも、難しい質問が多いので、だんだん付いていけなくなっています。
ご挨拶だけというのはできませんので、ちょっとレスをしておきます。
(COMアドインのご質問は答えられずにスルーしてしまいました。失礼しました。
Excel DNAを使いこなせれば、もう少しアドバイスができたのですが、今は無理です。)

解答は出ていますので、BAは不要なのですが、これは、面白いマクロになるのかもしれないと思い作ってみました。

環境依存文字というのは、Unicodeのことでしょうか。
調べてみると、上付き文字側が、順に並んでいないので、ややこしい気がします。
いままで、こういうものは考え方ことがありませんでした。

やってみると、わざわざ書式の上付き文字・下付き文字の検証よりも、パターンで、アルファベット＋数字の組み合わせで、変換しても良さそうな気がしました。

'//
Option Explicit
Sub ReplSuperScript()
Dim RegEx As Object
Dim Ms As Object, m As Object
Dim i As Variant, j As Variant, c As Range, k As Long
Dim buf As Variant
Dim spScr As Variant
上付き文字は、飛び飛びの不揃いの文字コードです。
spScr = Array("2070", "00B9", "00B2", "00B3", "2074", "2075", "2076", "2077", "2078", "2079")

Set RegEx = CreateObject("VBScript.RegExp")
With RegEx
　.Global = True: .IgnoreCase = True: .MultiLine = True
　.Pattern = "\w(\d+)"
　For Each c In Selection '対象セルをマウスで選択
　 buf = c.Value
　 Set Ms = .Execute(buf)
　 If Ms.Count > 0 Then
　　For Each m In Ms
　　 i = m.FirstIndex + 2
　　 '' a = Mid(buf, i, 1) '検査用
　　 If c.Characters(i, 1).Font.Superscript Then
　　　'上付き側
　　　j = m.subMatches(0)
　　　For k = 1 To Len(j)
　　　 Mid(buf, i + k - 1, 1) = ChrW("&H" & spScr(Val(Mid(j, k, 1))))
　　　Next k
　　 ElseIf c.Characters(i, 1).Font.Subscript Then
　　　'下付き側
　　　j = m.subMatches(0)
　　　For k = 1 To Len(j)
　　　 Mid(buf, i + k - 1, 1) = ChrW("&H2080" + Val(Mid(j, k, 1)))
　　　Next k
　　 End If
　　Next
　　c.Value = buf
　 End If
　Next
End With
End Sub

'//

グルコースの化学式

この回答へのお礼

こんにちは、いつもありがとうございます
プログラムありがとうございます
参考にさせて頂きます

これからもよろしくお願い申し上げます

お礼日時：2018/10/04 12:27