Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


869 / 13644 ツリー ←次へ | 前へ→

【77831】セル内の特定の文字列に囲まれた文字を上付き・下付きに置換したい 16/1/8(金) 14:58 質問[未読]
【77832】Re:セル内の特定の文字列に囲まれた文字を... ウッシ 16/1/8(金) 17:20 回答[未読]
【77833】Re:セル内の特定の文字列に囲まれた文字を... 16/1/8(金) 18:33 質問[未読]
【77834】Re:セル内の特定の文字列に囲まれた文字を... ウッシ 16/1/8(金) 18:49 回答[未読]
【77835】Re:セル内の特定の文字列に囲まれた文字を... 16/1/8(金) 19:18 お礼[未読]

【77831】セル内の特定の文字列に囲まれた文字を上...
質問    - 16/1/8(金) 14:58 -

引用なし
パスワード
   VBA初心者です。何卒ご教示頂きたくよろしくお願いいたします。

セル内の特定の文字列に囲まれた文字を
・上付き
・下付き
にそれぞれ置換したいです。

<セル内の特定の文字列に囲まれた文字>
上付き: <sup>・・・</sup>(<sup>と</sup>に囲まれた文字列)
下付き: <sub>・・・</sub>(<sub>と</sub>に囲まれた文字列)

例えば

  A列
1 ああああああH<sub>2</sub>OいいいいCl<sup>-</sup>ううO<sub>2</sub>えええ。
2 上上上上10cm<sup>3</sup>下下下下下N<sub>2</sub>上上上上。
3 ・
4 ・
5 ・
6 ・
7 ・



  A列
1 ああああああH2OいいいいCl-ううO2えええ。
※「2」が下付き、「-」が上付き

2 上上上上10cm3下下下下下N2上上上上。
※「2」が下付き、「3」が上付き

という風に変換させたいです。
(1つのセル内に複数存在する場合もあります。)

その他
・上記置換処理をA列とB列の複数列で実行させたいです。


何卒ご教授のほどよろしくお願いいたします。

【77832】Re:セル内の特定の文字列に囲まれた文字...
回答  ウッシ  - 16/1/8(金) 17:20 -

引用なし
パスワード
   こんにちは

<sup>・・・</sup>
<sub>・・・</sub>
が必ず対になっているとして、

Sub test()
  Dim r As Range
  Dim s As Long
  Dim u As Long
  Dim i As Long
  Dim j As Long
  Dim k As Long
  Dim p As String
  Dim t As String
  Dim s1 As Long
  Dim u1 As Long
  Dim v1()
  
  'A列とB列のデータ範囲を選択して実行
  
  For Each r In Selection
    t = ""
    i = 1: j = 0
    ReDim v1(1 To 2, 1 To 1)
    Do Until i > Len(r)
      p = Mid(r, i, Len(r))
      s = InStr(1, p, "<sub>")
      u = InStr(1, p, "<sup>")
      s1 = InStr(1, p, "</sub>")
      u1 = InStr(1, p, "</sup>")
      If s = 1 Or u = 1 Then
        j = j + 1
        ReDim Preserve v1(1 To 2, 1 To j)
      End If
      If s = 1 Then
        If s1 - s = 6 Then
          v1(1, j) = Len(t) + 1
          i = i + 5
          t = t & Mid(r, i, 1)
        Else
          i = i + 5
          For k = 0 To s1 - s - 6
            ReDim Preserve v1(1 To 2, 1 To j)
            v1(1, j) = Len(t) + 1
            t = t & Mid(r, i + k, 1)
            j = j + 1
          Next
          i = i + k - 1
        End If
      ElseIf u = 1 Then
        If u1 - u = 6 Then
          v1(1, j) = Len(t) + 1
          i = i + 5
          t = t & Mid(r, i, 1)
        Else
          i = i + 5
          For k = 0 To u1 - u - 6
            ReDim Preserve v1(1 To 2, 1 To j)
            v1(1, j) = Len(t) + 1
            t = t & Mid(r, i + k, 1)
            j = j + 1
          Next
          i = i + k - 1
        End If
      ElseIf s1 = 1 Then
        i = i + 6
        t = t & Mid(r, i, 1)
      ElseIf u1 = 1 Then
        i = i + 6
        t = t & Mid(r, i, 1)
      Else
        t = t & Mid(r, i, 1)
      End If
      i = i + 1
      s = 0
      u = 0
      s1 = 0
      u1 = 0
    Loop
    r.Value = t
    For i = 1 To UBound(v1, 2)
      If v1(1, i) <> "" Then
        r.Characters(Start:=v1(1, i), Length:=1).Font.Subscript = True
      ElseIf v1(2, i) <> "" Then
        r.Characters(Start:=v1(2, i), Length:=1).Font.Superscript = True
      End If
    Next
    r.WrapText = False
  Next
End Sub

で、うまく行くでしょうか?

【77833】Re:セル内の特定の文字列に囲まれた文字...
質問    - 16/1/8(金) 18:33 -

引用なし
パスワード
   ウッシ様

お世話になっております。
ご確認及びご教示頂き誠にありがとうございます。

教えて頂きましたVBAを実行したところ、
上付き「<sup>・・・</sup>」対象文字列が下付き
表示になってしまうのですが、
どうしたらよろしいでしょうか?

大変恐縮ですが、ご確認のほどよろしくお願いいたします。

【77834】Re:セル内の特定の文字列に囲まれた文字...
回答  ウッシ  - 16/1/8(金) 18:49 -

引用なし
パスワード
   こんばんは

コピペで修正している部分を直すの忘れてました。

Sub test()
  Dim r As Range
  Dim s As Long
  Dim u As Long
  Dim i As Long
  Dim j As Long
  Dim k As Long
  Dim p As String
  Dim t As String
  Dim s1 As Long
  Dim u1 As Long
  Dim v1()
 
  'A列とB列のデータ範囲を選択して実行
 
  For Each r In Selection
    t = ""
    i = 1: j = 0
    ReDim v1(1 To 2, 1 To 1)
    Do Until i > Len(r)
      p = Mid(r, i, Len(r))
      s = InStr(1, p, "<sub>")
      u = InStr(1, p, "<sup>")
      s1 = InStr(1, p, "</sub>")
      u1 = InStr(1, p, "</sup>")
      If s = 1 Or u = 1 Then
        j = j + 1
        ReDim Preserve v1(1 To 2, 1 To j)
      End If
      If s = 1 Then
        If s1 - s = 6 Then
          v1(1, j) = Len(t) + 1
          i = i + 5
          t = t & Mid(r, i, 1)
        Else
          i = i + 5
          For k = 0 To s1 - s - 6
            ReDim Preserve v1(1 To 2, 1 To j)
            v1(1, j) = Len(t) + 1
            t = t & Mid(r, i + k, 1)
            j = j + 1
          Next
          i = i + k - 1
        End If
      ElseIf u = 1 Then
        If u1 - u = 6 Then
          v1(2, j) = Len(t) + 1
          i = i + 5
          t = t & Mid(r, i, 1)
        Else
          i = i + 5
          For k = 0 To u1 - u - 6
            ReDim Preserve v1(1 To 2, 1 To j)
            v1(2, j) = Len(t) + 1
            t = t & Mid(r, i + k, 1)
            j = j + 1
          Next
          i = i + k - 1
        End If
      ElseIf s1 = 1 Then
        i = i + 6
        t = t & Mid(r, i, 1)
      ElseIf u1 = 1 Then
        i = i + 6
        t = t & Mid(r, i, 1)
      Else
        t = t & Mid(r, i, 1)
      End If
      i = i + 1
      s = 0
      u = 0
      s1 = 0
      u1 = 0
    Loop
    r.Value = t
    For i = 1 To UBound(v1, 2)
      If v1(1, i) <> "" Then
        r.Characters(Start:=v1(1, i), Length:=1).Font.Subscript = True
      ElseIf v1(2, i) <> "" Then
        r.Characters(Start:=v1(2, i), Length:=1).Font.Superscript = True
      End If
    Next
    r.WrapText = False
  Next
End Sub

【77835】Re:セル内の特定の文字列に囲まれた文字...
お礼    - 16/1/8(金) 19:18 -

引用なし
パスワード
   ウッシ様

ありがとうございます。
上手くできました。

構文を勉強させていただきます。

本当にありがとうございました。



869 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free