ネットが遅くてイライラしてない!?

Wordで作成した置換マクロをEXCELでも使用する方法を教えてください。

WordのマクロをエクスポートしてEXCELでインポートしましたが
うまく動きません。
同じofficeなのに対応はしていないのでしょうか??

このQ&Aに関連する最新のQ&A

A 回答 (5件)

こんにちは。



#1の補足のマクロは、たぶん、私の書いたものだと思いますが、前回と同じく、ご自身で作っていない場合は、他の人が書いた旨を書いていただいたほうがよいですね。そうしないと、マクロが出来ると勘違いされ、話がちぐはぐになってしまいます。一応、Excel版も掲示板に残しておきます。

正規表現のパターン の場所のそれぞれに、半角対象、全角対象の中に、Unicode の範囲の文字を入れるだけでよいです。なお、半角カタカナは、インターネット上で、半角カタカナが書けないために、便宜的に文字コードで入れているだけですから、実際にお使いの際は、半角カタカナでもかまいません。

ただし、特殊な記号の置換に関しては、ご自身で出来ないとは言いませんが、私のコードからでは、少し手間が多くなります。例 [1] -> (1)

単純なものなら、記録マクロでも良いかもしれません。

---------------------------------
'標準モジュール

Sub RegReplacement()
  '半角カタカナを全角に、全角英数を半角にするマクロ (Excel編)
  Dim rng As Range
  Dim Re As Object
  Dim myPat As String
  Dim c As Range
  Dim Matches As Object
  Dim Match As Object
  Dim Str1 As String
  Dim Str2 As String
  Dim buf As String
  Dim t As Long
  On Error Resume Next
  Set rng = ActiveSheet.UsedRange.SpecialCells _
  (xlCellTypeConstants, xlTextValues)
  On Error GoTo 0
  If rng Is Nothing Then
    MsgBox "変換する対象が見当たりません。", 48
    Exit Sub
  End If
  '全角側 --- 半角側 (!-/ を加えれば記号も半角)
  myPat = "([\uFF66-\uFF9F]*)([0-9A-z]*)" '正規表現のパターン
  Set Re = CreateObject("VBScript.RegExp")
  Application.ScreenUpdating = False
  With Re
    .Global = True
    .IgnoreCase = True
    .Pattern = myPat
    For Each c In rng.Cells
      Set Matches = .Execute(c.Value)
      If Matches.Count > 0 Then
        buf = c.Value
        For Each Match In Matches
          If Len(Match.Value) > 0 Then
            Str1 = StrConv(Match.SubMatches(0), vbWide)
            If Str1 <> "" Then
              '0 =vbBinaryCompare
              buf = Replace(buf, Match.SubMatches(0), Str1, , , 0)
            End If
            Str2 = StrConv(Match.SubMatches(1), vbNarrow)
            If Str2 <> "" Then
              buf = Replace(buf, Match.SubMatches(1), Str2, , , 0)
            End If
          End If
          Str1 = "": Str2 = ""
        Next Match
        If buf <> c.Value Then
          c.Value = buf
          t = t + 1
        End If
      End If
    Next c
  End With
  Set Re = Nothing
  Application.ScreenUpdating = True
  If t > 0 Then
    MsgBox t & "個のセルを変換しました。", 64
  End If
End Sub
    • good
    • 0
この回答へのお礼

いつもすいません。。
(_ _(--;(_ _(--; ペコペコ

記号は半角にしたいです。
どの行と置き換えればいいですか??

お礼日時:2008/06/05 20:26

こんばんは。



先ほど、同様のマクロ(記号も含めたもの)を書きましたので、

「QNo.4086577 EXCEL 「ASC」関数  英数字の全角を半角に変換するよい方法があれば教えてください 」

http://oshiete1.goo.ne.jp/qa4086577.html

こちらのほうも、一読ください。
    • good
    • 0

こんにちは。



>記号は半角にしたいです。
>どの行と置き換えればいいですか??

Wordよりも簡単ですから、非常に有効なコツを教えておきます。

-----------------------------------
 '全角側 --- 半角側 (!-/ を加えれば記号も半角)
>myPat = "([\uFF66-\uFF9F]*)([0-9A-z]*)" '正規表現のパターン
  ↓

myPat = "([\uFF66-\uFF9F]*)([!-/0-9A-z]*)" '正規表現のパターン

または、

myPat = "([\uFF66-\uFF9F]*)([!-}]*)" '正規表現のパターン

-----------------------------------
とすれば、!-/ の間を含めたものはすべて含みます、という意味です。!-}の場合は、その範囲すべてです。(連結の'-' は、必ず半角です)

この並びは、Unicode の並びです。MS-IME のIMEパッドの文字一覧を出して、上の窓の左側に、シフトJISとか、Unicode と出ているはずですから、Unicode にします。右側の窓には、MSゴシックとか、MS明朝とかします。そして、左隣の窓の「半角形/全角形」を選んで、その範囲を、半角の「-」で結べば、そのすべてを含めます、という意味になります。「0-9」は、全角の0から9まで、ということです。

実は、Wordでも、同じことが出来るのですが、Wordの場合は、必ずしも、そういう方式が良いとは限らないので、こういう方法を選ばなかったのです。

ただ、個々の全角→半角ではない場合は、Replace で個々に置き換えてあげる方法が一番楽かもしれません。
    • good
    • 0

こんにちは。



Word / Excel の VBA は、基本的な部分で共通ですが、多くのケースで
そのままでは動きません。

適当に書いたものですが、下記のコードが参考になれば。。。

余談ですが、電子納品において記号の扱いはどうなのでしょうか?
また、テキストボックス内等のテキストは検索対象外になってますので、
ご注意を。

Sub SampleProc()

  ' // 正規表現によりマッチした部分の全角・半角置換
  
  Dim reg    As Object ' // RegExp
  Dim regMatch  As Object ' // Match
  Dim rTarget  As Range
  Dim r     As Range
  Dim s     As String
  Dim i     As Long
  Dim vPatterns As Variant
  Dim vConverts As Variant
  
  ' // Matching Pattern 定義 --------------------------------------
  vPatterns = Array("[" & Chr("&HA6") & "-" & Chr("&HDF") & "]+", _
           "[0-9]+", _
           "[A-z]")
  ' // Conversion 定義(必ず Pattern と対応させる)-----------------
  vConverts = Array(vbWide, _
           vbNarrow, _
           vbNarrow)
  
  ' // 処理対象範囲を取得(定数のセルのみを扱う)
  ' // 23: All Value Type
  Set rTarget = Cells.SpecialCells(xlCellTypeConstants, 23)
  If rTarget Is Nothing Then
    MsgBox "置換対象はありません", vbInformation
    Exit Sub
  End If

  Application.ScreenUpdating = False
  Set reg = CreateObject("VBScript.RegExp")
  For Each r In rTarget.Cells
    s = r.Value
    For i = 0 To UBound(vPatterns)
      reg.Pattern = vPatterns(i)
      reg.Global = True
      For Each regMatch In reg.Execute(s)
        s = Replace$(s, regMatch, _
          StrConv(regMatch, vConverts(i)))
      Next
    Next
    r.Value = s
  Next r
  
  Set reg = Nothing
  Set rTarget = Nothing

End Sub
    • good
    • 1

そのままでは使えないと思います。



コードを↓にアップしてみてください。

この回答への補足

了解です。
宜しくお願いします。


Sub 電子納品禁止文字置換()
Dim buf As String
Dim t As Integer
Dim myMsg As String
Dim FChr As String
Dim LChr As String

Selection.HomeKey Unit:=wdStory '文書の先頭に
With Selection.Find
.ClearFormatting
.Text = ""
.Replacement.Text = ""
.MatchFuzzy = False

'半角カタカナ
FChr = Chr("&HA6") '半角ヲ
LChr = Chr("&HDF") '半角゜
While .Execute(FindText:="[" & FChr & "-" & LChr & "]{1,}", _
Wrap:=wdFindContinue, MatchWildcards:=True) = True
Selection.Range.CharacterWidth = wdWidthFullWidth
t = t + 1
Wend

'数字
While .Execute(FindText:="[0-9]{1,}", _
Wrap:=wdFindContinue, MatchWildcards:=True) = True
Selection.Range.CharacterWidth = wdWidthHalfWidth '半角
t = t + 1
Wend
'アルファベット
While .Execute(FindText:="[A-z]{1,}", _
Wrap:=wdFindContinue, MatchWildcards:=True) = True
Selection.Range.CharacterWidth = wdWidthHalfWidth
t = t + 1
Wend


End Sub

補足日時:2008/06/03 13:00
    • good
    • 0

このQ&Aに関連する人気のQ&A

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

このQ&Aと関連する良く見られている質問

QEXCEL 「ASC」関数  英数字の全角を半角に変換するよい方法があれば教えてください

EXCELで入力しているデータをフィルターを使用して検索できる
データベースにしたいのですが、以前からの入力しているデータの英数字が全角、半角が混在していてます。
フィルター検索の際に全角で入力すると半角入力のものがヒットしないので不便で、英数字の半角統一にしたいと考えています。

ASC関数を使用して英数字の全角→半角を行なうこと考えたのですが
ASC関数ですとカタカタも半角カタカナに変換されるので
英数字だけを全角→半角にする関数や方法などあれば教えてください。

入力データは
漢字、ひらがな、カタカナ、英数字が混在しています。

希望
全角→漢字、ひらがな、カタカナ
半角→英数字

宜しくお願い致します。

Aベストアンサー

こんばんは。

行きがかりで、以下の質問と同じですが、こちらにも書いておきます。

http://oshiete1.goo.ne.jp/kotaeru.php3?qid=4071741
#3 にマクロがあります。

それを手直しし、ユーザー定義関数に変更してみました。
標準モジュールに貼り付けてください。後は、通常の関数のように入れてくださればよいです。ただ、Office の場合は、ExcelのJIS 関数にしても、中身は、単に、1文字ずつを、全角にしているわけではありません。一文字ずつ変換するのは、どちらかというと中途半端な結果になってしまいます。

例えば、
「半角」で、パピプ と入れ、=LEN(A1) とすると、6
それを、JIS関数で変換して、=LEN(A2) とすると、3
が出てきます。

つまり、バ、パ など、半角の濁音、半濁音は、必ずまとめて全角に変換しなければなりません。また、VBA以外で、それを実行するときは、ストリームの中で、半濁音の監視をしないといけないわけですが、幸い、そのようなプログラムは必要ありません。Office に詳しくない方だと、この点を見落としてしまいます。

以下の関数は、フィルタになりますから、そのまま、マクロに入れることも可能です。その場合は、出来れば、VBScrip.RegExp は、参照設定して、そのまま、開放しないままにしておいたほう速いかもしれません。

なお、
>全角→漢字、ひらがな、カタカナ
カタカナ以外に対しては、漢字、ひらがなの半角文字はExcelにはないはずです。
また、=Now()関数 で[22時40分](書式:[DBNum3]h"時"mm"分") を表示したものも、[22時40分]と変換することは可能です。

'-------------------------------
'標準モジュール

Function Zen2Han(strText As Variant) As String
'全角:カタカナ,半角:英数字・記号
  Dim myPats As Variant
  Dim Re As Object ' As RegExp
  '参照設定では、Microsoft VBScript Regular Expressions 5.5
  Dim Matches As Object 'As MatchCollection
  Dim Match As Object 'As Match
  Dim buf As String
  Dim i As Integer
  '半角カタカナ, 全角英数など
  '半角のカタカナはWebで表示できないので、コードにしてあります。
  myPats = Array("([\uFF66-\uFF9F]+)", "([!-}]+)")
  
  If IsEmpty(strText) Then Exit Function
  If StrComp(TypeName(strText), "Range") = 0 Then
    strText = strText.Text
  End If
  Set Re = CreateObject("VBScript.RegExp")
  'Set Re = New VBScript
  With Re
    .Global = True
    .IgnoreCase = True
    buf = strText
   For i = 0 To 1
    .Pattern = myPats(i)
    Set Matches = .Execute(buf)
    If Matches.Count > 0 Then
      For Each Match In Matches
       buf = Replace(buf, Match, StrConv(Match, (i + 1) * 4), , , vbBinaryCompare)
      Next Match
    End If
  Next
End With
Zen2Han = buf
Set Re = Nothing
End Function

----------------------------------
''変換関数を組み合わせたマクロ(標準モジュール)

Sub Main()
  Dim c As Range
  Dim rng As Range
  On Error Resume Next
  Set rng = ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants, xlTextValues)
  On Error GoTo 0
  Application.ScreenUpdating = False
  If rng Is Nothing Then
    MsgBox "対象セルが見つかりません", vbExclamation, "終了"
    Exit Sub
  End If
  For Each c In rng.Cells
    c.Value = Zen2Han(c.Value)
  Next c
  Application.ScreenUpdating = True
End Sub

-----------------------------

こんばんは。

行きがかりで、以下の質問と同じですが、こちらにも書いておきます。

http://oshiete1.goo.ne.jp/kotaeru.php3?qid=4071741
#3 にマクロがあります。

それを手直しし、ユーザー定義関数に変更してみました。
標準モジュールに貼り付けてください。後は、通常の関数のように入れてくださればよいです。ただ、Office の場合は、ExcelのJIS 関数にしても、中身は、単に、1文字ずつを、全角にしているわけではありません。一文字ずつ変換するのは、どちらかというと中途半端な結果になってし...続きを読む


人気Q&Aランキング