ヘッダー行から変数作成 ② 禁則文字を少しだけ除去

前回は選択範囲の一行目をリストボックスに表示し、それらをクリップボード
格納してみた。
infoment.hatenablog.com

今日は、前回に続きから。
f:id:Infoment:20201101113122p:plain

前回は、VBEに貼り付けた時点で「No.」の「.」が、使ってはダメな文字ですよとシステムから注意を受けた。

そこで、リストボックスに表示する時点で、禁則文字をある程度除去しておくことにした。

ユーザーフォーム

禁則文字を全部網羅しても良いのだが、取り敢えず頻出記号に限定し、後は随時もぐらたたきで。

' 禁則文字の除去。
' とりあえず、よく登場するのだけ。
Private Function CheckNGCharacter(source_character As Variant) As String
    Dim temp As String
        temp = StrConv(CStr(source_character), vbWide)
    
    Dim NGCharacter As String
        NGCharacter = ",()/."
    
    Dim str As String
    Dim i As Long
        For i = 1 To Len(NGCharacter)
            str = Mid(NGCharacter, i, 1)
            Select Case str
                Case ")", "."
                    temp = Replace(temp, str, vbNullString)
                Case Else
                    temp = Replace(temp, str, "_")
            End Select
        Next
        CheckNGCharacter = temp
End Function

これを用いて、リストボックス用配列を作成の時点で、禁則文字を除去または置換を行った。

' 選択範囲からラベル行を取得して配列化。
Private Property Get HeaderList() As Variant
        
    ' 一列しかないなら、このツールは使わなくてもOK。
        If Selection.Columns.Count = 1 Then
            HeaderList = Array()
            Exit Property
        End If
    
    ' 表全体を選択されているかもしれないので、
    ' 一行目だけ配列に入れたうえで縦横入れ替え。
    Dim arr As Variant
        arr = Selection.Rows(1)
        arr = WorksheetFunction.Transpose(arr)
    
    ' 変数名などは重複が許されないため、辞書で重複確認。
    ' 重複した場合、後ろに数字を付す(重複毎カウントアップ)。
    Dim Dict As Object
    Set Dict = CreateObject("Scripting.Dictionary")
    Dim temp As String
    Dim i As Long
        For i = 1 To UBound(arr)
            ' 一旦全て全角にし、禁則文字の処理を簡素化する。
            ' (半角と全角で二回処理することを回避)。
            ' ※VBEに貼り付けた時点で、英数字は半角化する。
            temp = StrConv(arr(i, 1), vbWide)
            ' 禁則文字除去。
            temp = CheckNGCharacter(temp)
            If Not Dict.Exists(temp) Then
                Dict(temp) = 1
            Else
                Dict(temp) = Dict(temp) + 1
                Dict(temp & Dict(temp)) = 1
            End If
        Next
        HeaderList = WorksheetFunction.Transpose(Dict.Keys)
End Property

↓ コメント追加。
f:id:Infoment:20201101113938p:plain

ついでに、終了ボタンも追加。名前は「EndButton」とした。
f:id:Infoment:20201101114021p:plain

Private Sub EndButton_Click()
    Unload Me
End Sub
結果確認

それでは、↓ こちらで結果確認。
f:id:Infoment:20201101114138p:plain

期待する結果は、以下のとおり。

  1. No. ⇒ No
  2. 携帯(個人) ⇒ 携帯_個人

結果は、以下のとおり。
f:id:Infoment:20201101114752p:plain

次回は、これを変数宣言のかたちへ変更することに挑戦です。

参考まで。