[[20171212131129]]　『色を変えずに全角数字のみを半角にしたい』（どこどん）　ページの最後に飛ぶ

『色を変えずに全角数字のみを半角にしたい』（どこどん）

事前に選択したセル内の全角数字のみを半角にするVBAを作りましたが、元の数字は赤色と黒が混同しているのに変換後は全て黒になってしまいます。
他のサイトのコードも参考にしましたが全て色が変わってしまいました。

どうしたら元のフォント色を変えずに、全角英数のみを半角にできるでしょうか

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

 そのコードを示してみてくれないか？
（ねむねむ） 2017/12/12(火) 15:22

 こんなのではどうか。
 Sub tst()
    Dim WK_RANGE    As Range
    Dim CHAR_CNT    As Integer
    Dim WK_CHAR     As String

    For Each WK_RANGE In Selection
        With WK_RANGE
        For CHAR_CNT = 1 To Len(.Value)
            WK_CHAR = .Characters(CHAR_CNT, 1).Text
            If WK_CHAR >= "0" And WK_CHAR <= "9" Then
                .Characters(CHAR_CNT, 1).Text = StrConv(WK_CHAR, vbWide)
            End If
        Next
        End With
    Next

 End Sub

（ねむねむ） 2017/12/12(火) 16:18

ねむねむさん、全角半角変換が逆のようです。

セルの文字列全部を一度にセットすると、文字毎の色指定なんて全部消えて当たり前ですよね。貼った文字列が元と同じかどうかなんて、いちいち判定されませんから。

なので、色を残したいならば、1文字ずつ入れ替えるのがコードは簡単になります（何文字連続して同色か、なんて調べるのが面倒なので）。範囲指定後、右クリックすると、数字だけ1文字ずつ半角変換する例なぞ。

 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Dim R As Range
    Dim i As Long

    For Each R In Selection.SpecialCells(xlCellTypeConstants)
        For i = 1 To Len(R.Value)
            If Mid(R.Text, i, 1) Like "[０-９]" Then
                R.Characters(i, 1).Insert StrConv(Mid(R.Text, i, 1), vbNarrow)
            End If
        Next i
    Next R

    Cancel = True
 End Sub
（???） 2017/12/12(火) 16:24

 ???さんありがとう。
 どこどんさんすまない、
 >If WK_CHAR >= "0" And WK_CHAR <= "9" Then
 >    .Characters(CHAR_CNT, 1).Text = StrConv(WK_CHAR, vbWide)
 を
 >If WK_CHAR >= "０" And WK_CHAR <= "９" Then
 >    .Characters(CHAR_CNT, 1).Text = StrConv(WK_CHAR, vbNarrow)
 としてくれ。
（ねむねむ） 2017/12/12(火) 16:28

ありがとうございます。実はそんな当たり前を投稿後に知りまして……恥ずかしい限りです。
どうやっても一手間加わる面倒なことになるんですね。回答いただきありがとうございます。
コードは後ほど試してみます。
（どこどん） 2017/12/12(火) 17:45

報告です。
ねむねむさん、ありがとうございます。

頂いたコードは試しに文字を並べて動かしたところ無事綺麗に動作しました。
しかし実際の表にてマクロを動かすと実行時エラー1004が出ます。
問題があるのは

WK_CHAR = .Characters(CHAR_CNT, 1).Text

の部分なのですが、何がどう問題なのかさっぱりな状態です。関数や書式設定が引っかかったりするんでしょうか……

???さんありがとうございます。

頂いたコードを試そうとしましたが、私の知識不足なのか全く上手く動かせず……お力を頂いたのに全く活かせず大変申し訳無い結果になってしまいました。
数日勉強しただけでは中々上手くいかないものですね。
（どこどん） 2017/12/13(水) 17:45

私のコードは、シート上でセルを範囲選択した後、右クリックすると動作します。右クリックイベントなので、シートモジュールに貼りつけないと動きません。標準モジュールに貼ったのではないでしょうか？
（シートモジュールに貼るには、マクロの編集画面で、左側のツリーに表示されたシート名をダブルクリックしてください）
（???） 2017/12/13(水) 18:01

 正規表現で

 Sub test()
     Dim r As Range, m As Object
     With CreateObject("VBScript.RegExp")
         .Global = True
         .Pattern = "[０-９]+"
         For Each r In Selection
             For Each m In .Execute(r.Text)
                 r.Characters(m.firstindex + 1, m.Length).Text = StrConv(m.Value, vbNarrow)
             Next
         Next
     End With
 End Sub

 Range.Characters.Text はセル内の文字数が255を超えると機能しません。
（seiya） 2017/12/13(水) 23:00

="１２３" & "４５６"
のような式であった場合は、どなたのコードでもうまくいきません。
いったん、コピー＋値貼り付けで値に変換する必要があります。

（γ） 2017/12/14(木) 00:52

数式だったら部分着色なんてできませんよね？最初の要望から外れていませんか？

コードで使われている命令を検索するとか、ヘルプで確認すると判るのですが、私のコードは、数式はわざと変換しないように考えたものです。だって、数式は事前に仕込むものであり、それが全角なのは入力ミスではなく、故意だと思いますから。

数式を変えたいならば、xlCellTypeConstants を xlCellTypeFormulas に変えて同様のループを追加し、元のやり方でFormulaプロパティを丸ごと置換するよう変えてみてください。

そして、他のセルを参照していて、そっちが全角な場合、数式を壊して固定値に変えるか、元データを直すかしないと駄目ですよ？
（???） 2017/12/14(木) 09:08

と思ったら、質問者からの変更要望ではなく、γさんからの突っ込みだったのですね。
まぁ、そういうわけで、定数だけ変換すれば良いと判断した訳です。
（???） 2017/12/14(木) 09:11

 式があった場合にエラーにならないように修正。
 >For CHAR_CNT = 1 To Len(.Value)
 >    WK_CHAR = .Characters(CHAR_CNT, 1).Text
 >    If WK_CHAR >= "０" And WK_CHAR <= "９" Then
 >        .Characters(CHAR_CNT, 1).Text = StrConv(WK_CHAR, vbNarrow)
 >    End If
 >Next
 の前に
 If .Text = .Formula Then
 後ろに
 End If
 を入れてみてくれ。

（ねむねむ） 2017/12/14(木) 09:28

報告です

???さん、ありがとうございます。
非常に感動して変な笑いが出てしまいました。マクロのモチベーションが上がりました。
今回は別の担当者が投げてくる大量のExcelシートを校正するためのマクロだったのですが、別の部分に応用で使わせていただきます。新しいゲームに触れるような嬉しさがあって楽しかったです

seiyaさん、ありがとうございます。
何も問題なく動作した上に、データ量がかなり多くなった場合でも非常にスムーズでした。
助かりました、ありがとうございます。

γさん、大変失礼いたしました。
恐らく私の「式がエラー原因かもしれない」という文章に対しての指摘だと思いますが、一部に式があるだけで式の結果が全角になっているわけではないのです。
誤解させるような文章にお手間割かせてしまい申し訳ございませんでした。

ねむねむさん、ありがとうございます。
図らずもコード修正の遍歴を確認することでとても良い勉強になりました。
実装に関してはどなたのを使うのか決めては居ないのですが、知識としてお力になっていただき非常に助かりました。これからの糧にさせていただきます。

皆様のおかげで無事に解決いたしました。お力添え頂きありがとうございました。
（どこどん） 2017/12/14(木) 11:38

コメント返信：

[ 一覧(最新更新順) ]

[[20171212131129]] 『色を変えずに全角数字のみを半角にしたい』（どこどん） ページの最後に飛ぶ

[[20171212131129]]　『色を変えずに全角数字のみを半角にしたい』（どこどん）　ページの最後に飛ぶ