dポイントプレゼントキャンペーン実施中!

エクセルで立方メートルm3の3を上付にしたり、化学式の指数部を下付にするのはかなり面倒ですが、マクロでこの作業を簡単にしたいと思っています。ところがマクロを作ること自体が初心者なもので、このサイトで見つけて化学式の方は解決したのですが、それを参考に作ろうにもどこをどーいじっていーものやらさっぱりわからず、中々ビンゴのマクロが作れません。どなたかお力添えを。

A 回答 (3件)

分かりやすく書いたつもりです。

変更したい範囲を選択して実行します。
化学式やこれらのマクロを、ツール→マクロ→マクロ→オプションでショートカットキーに割り当てれば操作性もよくなると思います。

以下は標準モジュールに貼り付けます。ご参考に。

Public Sub m3_Uetuki()
  Dim rg As Range 'セル
  Dim L As Integer 'カウンタ
  Dim Shiki As String '式(文字列)
  Dim moji As String 'mか?

  For Each rg In Selection
    Shiki = rg.Text

    For L = 1 To Len(Shiki) - 1 '文字の長さ-1を調べる
      Select Case Mid(Shiki, L, 1) '調べる文字
        Case "m", "m" '半角または全角のm
          Select Case Mid(Shiki, L + 1, 1) '次の文字
            Case "3", "3" '半角または全角の3
              '上付き文字にする
              rg.Characters(L + 1, 1).Font.Superscript = True
            Case Else
          End Select
        Case Else
      End Select
    Next
  Next
End Sub
    • good
    • 0
この回答へのお礼

ありがとうございました。
助かりました。

お礼日時:2001/12/11 15:17

以前回答したことがあります。

化学式を簡単に入力する方法(http://www.okweb.ne.jp/kotaeru.php3?q=133017)

上記例でいえば、下付き文字は『化学式』だからこのVBAでできています。どこからどこまでが添え字か一意に決まるからです。

質問にある平方メートルや立方メートルだけなら簡単にできますが、一般的な式を自動的に評価するのは困難でしょう。
例えば、A12はAの12乗かA1の2乗かは判別不能でしょう。(化学式のH2Oはどの文字を下付きにするかは判定できます)

今回作ってみたのは、ルールに従って入力すれば、上付き・下付きに変換するマクロです。
 ○上付きのルール・・・開始位置に『^』を入力し、終了位置に『スペース1個』
 ○下付きのルール・・・開始位置に『_』を入力し、終了位置に『スペース1個』
例えば、
  f_x =X^n +Y^n =Z^n  や
  9^3 +10^3 =12^3 +1^3 や m^2、m^3、H_2 O のように入力します。

かなり長くなってしまいました。標準モジュールに貼り付け、セル範囲を選択して実行します。

Public Sub UesShitatukiMoji()
  '上付き、下付き文字は『^』、『_』と『スペース1個』で挟まれている前提!
  '1つのセル内に100個の上付き、下付き文字まで可能
  Dim rg As Range 'セル
  Dim Moji As String 'セルの式(文字列),最初の文字列
  Dim pUp As Integer, pDw As Integer '上付き位置、下付き位置
  Dim UPorDW(100) As Boolean '上付きか下付きか
  Dim p1(100) As Integer, p2(100) As Integer '『^』or『_』と『スペース』の位置
  Dim cot As Integer, ss As Integer 'カウンタ

  For Each rg In Selection
    Moji = rg.Text & " "
    Moji = Application.Substitute(Moji, "^", "^") '全角なら半角に置き換える
    Moji = Application.Substitute(Moji, "_", "_") '全角なら半角に置き換える
    Moji = Application.Substitute(Moji, " ", " ") '全角なら半角に置き換える

    cot = 1
    pUp = InStr(1, Moji, "^") '上付き
    pDw = InStr(1, Moji, "_") '下付き
    UPorDW(cot) = SUPERorSUBscript(pUp, pDw)
    If pUp = 0 Then pUp = pDw
    If pDw = 0 Then pDw = pUp
    p1(cot) = WorksheetFunction.Min(pUp, pDw)
    While p1(cot) > 0
      If p1(cot) > 0 Then 'べき乗の位置を調べる
        p2(cot) = InStr(p1(cot) + 1, Moji, " ")
      End If

      cot = cot + 1
      pUp = InStr(p2(cot - 1), Moji, "^")
      pDw = InStr(p2(cot - 1), Moji, "_")
      UPorDW(cot) = SUPERorSUBscript(pUp, pDw)
      If pUp = 0 Then pUp = pDw
      If pDw = 0 Then pDw = pUp
      p1(cot) = WorksheetFunction.Min(pUp, pDw)
    Wend
    '『^』と『_』と『スペース』を削除する
    For ss = cot - 1 To 1 Step -1
      Moji = Left(Moji, p2(ss) - 1) & Right(Moji, Len(Moji) - p2(ss))
      p2(ss) = p2(ss) - (ss - 1) * 2
      Moji = Left(Moji, p1(ss) - 1) & Right(Moji, Len(Moji) - p1(ss))
      p1(ss) = p1(ss) - (ss - 1) * 2
    Next

    If cot > 1 Then '上付きまたは下付き指定があった場合
      rg = Moji
    End If

    '上付きまたは下付き文字にする
    For ss = 1 To cot - 1
      If UPorDW(ss) Then
        rg.Characters(p1(ss), p2(ss) - p1(ss) - 1).Font.Superscript = True
      Else
        rg.Characters(p1(ss), p2(ss) - p1(ss) - 1).Font.Subscript = True
      End If
    Next
  Next
End Sub

'上付きにするか下付きにするか判定する関数(上付きがTrue)
Public Function SUPERorSUBscript(Upot As Integer, Dpot As Integer)
  If Upot > 0 Then
    SUPERorSUBscript = True
    If Dpot > 0 Then
      If Dpot < Upot Then
        SUPERorSUBscript = False
      End If
    End If
  End If
End Function

この回答への補足

>質問にある平方メートルや立方メートルだけなら簡単にできますが、・・・
まさにそれが欲しかったりします。複数の人に浸透させ
たいので、できればルール入力なしでやりたいです。
mの後ろの3は上付にしたい(それ以後の文字は普通)
というマクロがあるだけで充分今より楽になります。
&よく使う化学記号は決まっていて、
H2SO4、H2O2、CaCO3、CaF2、--(OH)2
FeCl3、--(OH)3、NH3、NH4 (頻用順)です。
また、A列は化学記号が、C列にm3など単位つきの数字
(式)が入る項目である事が予想できる雛形を使用しての
作業です。選択範囲内だけに各定義のマクロをながす
こまめな方法になっても構いませんのでお教え下さい。
マクロは使いたいけど作り方やアレンジの仕方はさっ
ぱりわからないものでよろしくお願いします。

補足日時:2001/12/06 13:29
    • good
    • 0

>このサイトで見つけて化学式の方は解決したのですが、


どのように、解決されたのでしょうか?

それがわかれば、マクロについては、詳しい方が沢山居られますから、回答をもらえるかも知れません。補足お願いします。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!