FC2ブログ

クイズの問題文用に1桁の半角数字だけ全角にするVBAマクロを作った

クイズ界では問題文を次のような書式で書くルール(とまで厳密じゃないにしてもそういう傾向)がある。

原則として数字は半角数字で記載するが、1桁の数字の場合のみ全角数字で記載する。

自分で問題を作成したり、転記したりする時に出来る限り気をつけてはいるつもりなのだが、
やはり人間のやる事なのでたまにミスる。

そこで、最近仕事でVBAを使うようになったこともあり、
勉強も兼ねて簡単なVBAのコードを書いてみた。
1桁の数字のみ全角数字にして、あとは半角数字にするというただそれだけのVBAマクロである。

処理としては、いったんすべての数字を半角数字にして、
その後1桁の数字のみ全角に変換するようにしている。
一応小数点の判定もしている。
(小数点の数字は半角のまま)

なお、文字列しか判定していないはずなので、
問題番号等を数字で書いてある場合はそこは変換しません。
変換したいセルはあらかじめ表示形式を文字列にする必要があります。

動くかどうかの保証もしないし、このコードを使って何が起きても責任は持ちませんが、
もし使いたいという奇特な人が入れば、ご自由にお使いください。
なお作成はExcel2016で行いましたが、多分2007以降なら動くはずです。
ぶっちゃけもっと前のバージョンでも動くはずです。保障はしませんが。

なお、ブログではタブが反映されないようなので全角スペースに変換していますが、
そこは一斉置換とかで対応願います。


―――――ソースコードはここから―――――

'1桁の数字はすべて全角数字に
'2桁以上の数字はすべて半角数字に
'小数点やカンマで区切られた数字は2桁以上の数として扱い全角にはしない
Sub クイズ問題用数字変換()
  
  '変数宣言
  Dim i As Long    '繰り返し用変数(Long型)
  Dim c As Range   '繰り返し用変数(Range型)
  Dim MaxRow As Long '最終行代入用変数
  Dim MaxCol As Long '最終列代入用変数
  Dim buf As Variant '文字列取得用
  Dim flag As Boolean 'フラグ用
  
  '画面の再描画/自動計算を停止
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  
  '最終行および最終列を取得
  With ActiveSheet.UsedRange
    MaxRow = .Rows(.Rows.Count).Row
    MaxCol = .Columns(.Columns.Count).Column
  End With


  '全角数字を全て半角数字に変換する処理
  
  '使用されているセルの範囲を繰り返す
  For Each c In Range(Cells(1, 1), Cells(MaxRow, MaxCol))
    
    '変数初期化
    buf = ""
    
    '文字列を1文字ずつ最後の文字まで繰り返す
    For i = 1 To Len(c.Value)
    
      '全角数字判定部分
      If Mid(c.Value, i, 1) Like "[0-9]" Then
        
        '全角数字なら、半角数字に変換する
        buf = buf & StrConv(Mid(c.Value, i, 1), vbNarrow)
      
      Else
        
        'それ以外の文字ならそのまま
        buf = buf & Mid(c.Value, i, 1)
      
      End If
      
    Next i
    
    '全角数字→半角数字変換後の文字列を元のセルに代入
    c.Value = buf

  Next c
  
  
  '1桁の半角数字を全角数字に変換する処理

  '使用されているセルの範囲を繰り返す
  For Each c In Range(Cells(1, 1), Cells(MaxRow, MaxCol))
  
    '変数初期化
    '(行頭の場合前の文字列はないので初期値をFalseにしている)
    flag = False
    buf = ""
    
    '文字列を1文字ずつ最後の文字まで繰り返す
    For i = 1 To Len(c.Value)
    
      '半角数字でかつ次の文字が半角数字でかつ前の文字が数字でないかを判定
      '半角ピリオドや半角カンマで続いているものは連続した数字として扱い全角にしない
      If Mid(c.Value, i, 1) Like "[0-9]" _
      And Not Mid(c.Value, i + 1, 1) Like "[0-9]" _
      And Not Mid(c.Value, i + 1, 1) = "." _
      And Not Mid(c.Value, i + 1, 1) = "," _
      And flag = False Then
         
        '1桁の半角数字なら全角数字に変換
        buf = buf & StrConv(Mid(c.Value, i, 1), vbWide)
      
      Else
        
        'それ以外の文字ならそのまま
        buf = buf & Mid(c.Value, i, 1)
      
      End If
      
      '文字列から取り出した1文字が数字または半角ピリオドまたは半角カンマだったかを判定して
      'それらに該当すればTrue、該当しなければFalseをflagに代入
      'これにより前の文字が数字などの場合に次の文字を全角にしない判定に使用
      If IsNumeric(Mid(c.Value, i, 1)) = True _
      Or Mid(c.Value, i, 1) = "." _
      Or Mid(c.Value, i, 1) = "," Then
        flag = True
      Else
        flag = False
      End If
      
    Next i
    
    '1桁の半角数字→全角数字変換後の文字列を元のセルに代入
    c.Value = buf

  Next c
  
  '画面の再描画/自動計算を再開
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True

End Sub


―――――ソースコードはここまで―――――


以上。
スポンサーサイト

コメントの投稿

非公開コメント

プロフィール

GYM

Author:GYM
柏レイソルとか
クイズとか
天鳳とか
将棋とか
囲碁とか
スポーツ観戦とか
そんなのが好きです

最新記事
最新コメント
最新トラックバック
月別アーカイブ
カテゴリ
カウント数
検索フォーム
RSSリンクの表示
リンク
ブロとも申請フォーム

この人とブロともになる

QRコード
QR