【ExcelVBA】エクセルで指定数以外の文字列を伏字に置換する

エクセルでメールアドレスなどの個人情報の保護を理由に1部分を残して伏字にしたい。
今回は、メールアドレスの文字列のうち左から8桁残して、それ以外の文字列を伏字(“x”)に変換する。

【要件】

  • ・文字列が打ち込まれた時コピペされた時に伏字にしたものに上書きする。
  • ・左から8文字はそのまま残し、それ以外の文字列を伏字(“x”)に置換する。
  • ・メールアドレスを元に戻す必要はない。

【仕様】

  • Worksheet_Change()セルの値が変更された時に発生するイベントを利用する。
  • 対象カラムを指定し、その列に打ち込まれた文字列のみ処理を行う。
  • ・文字列がない場合エラーになるので、0文字以上の場合のみ実行する。

【コード】

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ColNum
    '対象カラムを指定
    ColNum = 3

    '対象カラムで条件分岐
    If Target.Column = ColNum Then
        Call putSecurityText(Target.row, Target.Column)
    End If
End Sub
  
'指定したrowとColumnからセルを割り出し文字列をセキュリティコードに上書きするサブプロシージャ
Sub putSecurityText(row, col)
    Dim num
    Dim xText
    Dim SecurityText
    Dim cellVal
    
    '残すテキスト数
    num = 8
    cellVal = Cells(row, col).Value

    leftVal = Left(cellVal, num)
    lenVal = Len(cellVal)
    cntVal = lenVal - num
    
    '文字列分"x"を生成し連結する
    For i = 1 To cntVal Step 1
    xText = xText & "x"
    Next i
    
    SecurityText = leftVal & xText
    
    '文字列が0以上の場合のみ実行
    If lenVal > 0 Then
        Cells(row, col).Value = SecurityText
    End If
End Sub

‘Target.Column’,'Target.Row’からセルの列番号,行番号を取得することが出来る。

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

次のHTML タグと属性が使えます: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <strike> <strong>