Sub 集計用列を挿入()
    Dim col As Long: col = Selection.Column
    Dim strCol As String: strCol = getStrCol(col)
    
    Dim tGyo As Long: tGyo = 1
    If Cells(tGyo, col) = "" Then tGyo = Cells(tGyo, col).End(xlDown).Row
    Dim edGyo As Long: edGyo = Cells(Rows.Count, col).End(xlUp).Row
    
    Dim myRange As range: Set myRange = range(Cells(tGyo, col), Cells(edGyo, col))
    Dim myArr: myArr = myRange.Value
        
    Dim rc As Long: rc = MsgBox(strCol & "列の集計用列を追加します。数値を無視しますか？", vbYesNoCancel)
    If rc = vbCancel Then End
 
    Dim i As Long, n As Long, tStr As String
    If rc = vbYes Then
        For i = 1 To UBound(myArr)
            For n = 0 To 9
                myArr(i, 1) = Replace(myArr(i, 1), n, "")
            Next n
        Next i
        tStr = "_rmNum"
    End If
    
    Dim inputMsg As String: inputMsg = "抽出文字数 Nを入力してください。" & Chr(10) & "+の場合：Left（N)　　-の場合：Right（N)"
    Dim strLen: strLen = InputBox(inputMsg, "抽出文字数入力")
    If strLen = "" Then strLen = 0
    If IsNumeric(strLen) = False Then Call errorEnd("0以外の数値を入力してください")
    If strLen > 0 Then
        For i = 1 To UBound(myArr)
            myArr(i, 1) = Left(myArr(i, 1), strLen)
        Next i
        tStr = tStr & "_Left" & strLen
    ElseIf strLen < 0 Then
        For i = 1 To UBound(myArr)
            myArr(i, 1) = Right(myArr(i, 1), Abs(strLen))
        Next i
        tStr = tStr & "_right" & Abs(strLen)
    End If

    Selection.EntireColumn.Offset(0, 1).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    myRange.Offset(0, 1).NumberFormatLocal = Cells(tGyo + 1, col).NumberFormatLocal
    myRange.Offset(0, 1).Value = myArr
    Cells(tGyo, col + 1) = Cells(tGyo, col).Value & tStr
End Sub

Private Function getStrCol(ColNumber As Long) As String
    '列番号を列文字に変換
    getStrCol = Split(Cells(1, ColNumber).Address(True, False), "$")(0)
End Function

'エラー発生時にメッセージを出力して終了させる
Private Sub errorEnd(msg)
    Application.ScreenUpdating = True   'おまじない
    MsgBox msg
    End
End Sub