「教えて!ピックアップ」リリース!

エクセルでのデータの統一に関して

リストを作成する際、元データをコピペでリストに転記しており、元データの提供者が全角や半角、氏名の間にも全角半角のスペースなど混在しており、データ管理が煩雑化しております。

転記する際に確認して実施をすれば問題はございませんが、目視ですと見落としの可能性もございますし、非効率とおもいます。

つきましては、VBAまたは関数などで、整形や変換をして全角半角を意識せず管理をしたいです。

該当セルに半角を入れると弾かれ全角でしか入れられないようにポップアップなども表示されると尚嬉しいです。

実際にこうしているなどのアイディアがございましたら、ご教示いただけますと幸いです。

A 回答 (2件)

こんちには。



過去ほぼスルーされたソースコードですが、1度試してみてください。

VBA でブック内の全シートをまとめて全角英数を半角化、半角カナを全角化に正規化します。

適当なブックを作って Visual Basic Editor を開き、標準モジュールを挿入、以下ソースコードをコピペ。

全半角の正規化対象となるブックをアクティブにしてからマクロを実行です。


' 定数セルのみ対象(数式やシェープは対象外)
'
Public Sub 全シートの全角半角を統一()
  
  Dim sh As Worksheet
  
  For Each sh In ActiveWorkbook.Worksheets
    If sh.ProtectContents Then
      MsgBox "シート [" & sh.Name & "] は保護されています", vbExclamation
    Else
      '英数字の半角化
      Call RegStrConvertInWorksheet(sh, "([0-9a-zA-Z]+)", vbNarrow)
      '半角カナの全角化
      Call RegStrConvertInWorksheet(sh, "([ー\uFF61-\uFF9F]+)", vbWide Or vbKatakana)
    End If
  Next

End Sub

Private Sub RegStrConvertInWorksheet( _
  ByRef sh As Worksheet, _
  ByRef reg_pattern As String, _
  ByVal mode As VbStrConv _
)

  If Len(reg_pattern) = 0 Then Exit Sub

  On Error Resume Next
  Dim datas As Range
  Set datas = sh.Cells.SpecialCells(xlCellTypeConstants, xlTextValues)
  On Error GoTo 0
  
  If datas Is Nothing Then Exit Sub
  
  On Error GoTo Err_Handler
  
  Dim reg As Object 'RegExp
  Set reg = CreateObject("VBScript.RegExp")
  
  With reg
    .Pattern = reg_pattern
    .Global = True
    .IgnoreCase = False
  End With
  
  Dim area As Range
  For Each area In datas.Areas
    Dim buff As Variant: buff = area.Value
    If Not IsArray(buff) Then
      Dim tmp As Variant: tmp = buff
      ReDim buff(1 To 1, 1 To 1)
      buff(1, 1) = tmp
    End If
    Dim i As Long, j As Long
    For i = 1 To UBound(buff)
      For j = 1 To UBound(buff, 2)
        Dim mc As Object 'MatchCollection
        Dim m As Object 'Match
        Set mc = reg.Execute(buff(i, j))
        For Each m In mc
          buff(i, j) = Replace$(buff(i, j), m, StrConv(m, mode))
        Next
        Set mc = Nothing
      Next
    Next
    area.Value = buff
  Next

Finally:
  Set reg = Nothing
  Exit Sub
Err_Handler:
  MsgBox Err.Description, vbCritical, "ERROR: Procedure: RegStrConvertInWorksheet"
  End
End Sub
    • good
    • 1

半角から全角にするにはJIS関数を使う。



VBAでは、h$が半角を含む文字列のとき、
z$ = StrConv(h$, vbWide)
で全角だけの文字列z$が得られます。
    • good
    • 0

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

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング