エクセルでのデータの統一に関して リストを作成する際、元データをコピペでリストに転記しており、元デー

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

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

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

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

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

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

No.2 回答者： KenKen_SP 回答日時： 2022/08/31 18:02

こんちには。

過去ほぼスルーされたソースコードですが、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, "([０-９ａ-ｚＡ-Ｚ]+)", 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

No.1 回答者： stomachman 回答日時： 2022/08/31 15:45

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

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