EXCELマクロ上付き文字サイズが標準サイズになる

質問

こんにちは。度々お世話になっております。
コード上で指示をしていないのに、上付き文字サイズが標準サイズになってしまいます。
ChatGPTを駆使して上付き文字だけを特定させたりを試したのですが、解決できていません。
書式スタイルの設定や、条件付き書式などの疑わしいところも一通り問題ないとしています。
ズバリわかる方、検討つく方アドバイスをお願いします。コードは下記です。

Sub NEM_Macroループ_Local_フォント変更OK_上付修正だけ()
'
' フォント変更、記号変換、テキストボックス、全シート
'
Dim wb As Workbook
Dim ws As Worksheet
Dim shp As Shape
Dim cell As Range
Dim rng As Range

Application.ScreenUpdating = False

'変更するファイルが保存されているフォルダのパスを指定します。
myPath = C:\Users\Desktop\NEM_macro

'指定したフォルダ内の全てのExcelファイルに対してループを実行します。
myFile = Dir(myPath & "\*.xlsx")
Do While myFile <> ""

' 各ファイルを開きます。
Set wb = Workbooks.Open(myPath & "\" & myFile)

' フォントを設定、記号の置換
For Each ws In wb.Worksheets
Set rng = ws.UsedRange
rng.font.Name = "ＭＳ Ｐゴシック"

For Each cell In rng
' セル内の文字列を取得
Dim text As String
text = cell.Value

If WorksheetFunction.CountA(cell) > 0 Then
' 日本語の場合
If ContainsJapanese(cell.Value) Then
cell.font.Name = "ＭＳ Ｐゴシック"
End If

' 半角カタカナの場合
If ContainsHalfWidthKatakana(cell.Value) Then
cell.Value = Application.WorksheetFunction.Substitute(cell.Value, "ｶﾞ", "ガ")
cell.Value = Application.WorksheetFunction.Substitute(cell.Value, "ｷﾞ", "ギ")
' 他の半角カタカナを全角に変換するコードを追加する
cell.font.Name = "ＭＳ Ｐゴシック"
End If

' 英数の場合
If ContainsAlphanumeric(cell.Value) Then
cell.font.Name = "Arial"
' ※をArialに変換
cell.Value = Replace(cell.Value, "※", "Arial※")
End If

' 全角数字の場合
If ContainsFullWidthNumbers(cell.Value) Then
cell.Value = Application.WorksheetFunction.Substitute(cell.Value, "０", "0")
cell.Value = Application.WorksheetFunction.Substitute(cell.Value, "１", "1")
' 他の全角数字を半角に変換するコードを追加する
cell.font.Name = "Arial"
End If
End If

' 句読点の置換
cell.Value = Replace(cell.Value, ",", "，")
cell.Value = Replace(cell.Value, "、", "，")
cell.Value = Replace(cell.Value, ";", "；")
cell.Value = Replace(cell.Value, ":", "：")
cell.Value = Replace(cell.Value, "※", "*")
cell.Value = Replace(cell.Value, "＊", "*")

' 半角カタカナを全角カタカナに変換
cell.Value = ConvertHalfWidthKatakanaToFullWidthKatakana(cell.Value)

' 全角数字を半角数字に変換
cell.Value = ConvertFullWidthNumbersToHalfWidthNumbers(cell.Value)

' 作成したWorkbookを名前を付けて、移動先フォルダに保存します
（省略してます）
wb.Close

' 次のファイルに移動します。
myFile = Dir()
Loop

End Sub
文字列に日本語が含まれているかを判定するためのFunction コードが下記に続きます。

回答No.2

imogasi

下記が全くの誤解ならすみません。
ーー
質問に「上付き文字」という語句が出てくるので、念のためWEB記事を探したら、「上付き文字」なら
Sub Sample2()

Cells(1, 1).Characters(3, 1).Font.Superscript = True

With Cells(2, 1)
.Characters(3, 1).Font.Subscript = True
.Characters(5, 1).Font.Subscript = True
End With

Cells(3, 1).Font.Strikethrough = True

End Sub
のようなコード例が出ました。
質問文のコード例を見ると、このCharactersやSuperscriptが出てこないのはなぜですか。
質問は、別の事項を言っている質問しているのでしょうか。
ーー
コードをコピペするよりも、セル番地を指定した、「セルの値」の数例を挙げて、最終結果はこうなってほしいという書き方をしてほしい。
そしてコード例は回答者に任せる。
（コードを挙げて、あとは、読者が頭を働かせろということらしいが意思疎通がうまく行かない方が多いと思うが）
ーー
Substituteなど出てきますが（カタカナでの小文字に変換の例）、全体に（日本語の文章に対してらしいが）何をしたいのか文章で説明すべきでは。
どういう（項目の）見てくれの修正・改善をしたいのでしょうか。

補足

マクロもOKwaveも初心者で、質問が下手で申し訳ないです。確かにコードを貼っただけで何をしたいかがわかりにくいですね。
上付き文字に対してコード上では指示をしていないのに文字サイズに変更が起こるのを問題としていました。自分がわかっていないだけで、コードが文字サイズを変更する内容になっていないかどうかを知りたかったです。
m-take0220さんが回答いただいた内容にヒントがあるようなので、コードを見直したいと思います。

回答No.1

m-take0220

セル内の文字に「上付き」が設定されているかどうかは、

cell.Characters(Start:=n, Length:=1).Font.Superscript

を調べれはわかります。(上記はn文字目を調べる場合の記述)

cell.Valueに文字列を設定すると、文字ごとに設定されたフォントの情報は失われて、すべてセルの標準のフォントの状態に設定されます。Valueプロパティは文字列だけしか持たないため、各文字のフォントが変更されていることを同時に取得したり設定したりすることができないためです。

上付き文字を維持するためには、文字列を変更する前に各文字に上付きが設定されているかを調べておき、変更した文字列の中のどの文字を上付きにする必要があるかを判断して、上付きにしたい文字に対してSuperscriptをTrueに設定する必要があります。

お礼

ありがとうございました。ご指摘の内容は知りませんでした。いただいた内容をヒントにして修正してみます。