エクセルのセル内でタブキーのような機能でそろえる

よろしくお願いします。

ワード2010の表機能だと、【Ctrl + Tab】でTab機能が使えるようですが、エクセルに同様の機能はありますでしょうか。

エクセルの一つのセル内で下記のようなことをしたいです。

N01 あいうえお
No2 かきくけこ
No10 さしすせそ


No1、No2は左揃えでそろっているのですが、【No】と【あいうえお】等（仮に本データと呼びます）の間にスペースを入れており、本データの開始位置をそろえたいです。

No1、とNo10では、本データを入力する開始位置をそろえることが難しく、現在自分で全角、半角のスペースを入れてそろえていますが、Tabキーのような形で簡単にそろえることは出来ないでしょうか

教えてください。

よろしくお願いします。

No.1 回答者： d-q-t-p 回答日時： 2016/06/30 10:40

> エクセルに同様の機能はありますでしょうか。

ありません。 Excelは表計算ソフトですから １セルに複数の情報を入れ
込むことは最初から想定していません。逆をいえば 別々のセルに分けて
おけば それを後で揃えて表示させることは難しくありません。

No.2 回答者： WindFaller 回答日時： 2016/06/30 16:02

こんにちは。

マクロで、ショートカットの設定まで含めたコードを作ってみました。
このマクロは、正規表現で、No1の部分を探して、最大文字数を調べて、空白を入れるという仕組みになっています。

　.Pattern = "^(No\.*\d+)\b"
　
>現在自分で全角、半角のスペースを入れてそろえていますが、Tabキーのような形で簡単にそろえることは出来ないでしょうか
大きな問題は、MS P ゴシックと、プロポーショナルになっている所を変更しています。空白の場所は避けて通ります。

★の部分を書き換えると、上書きモードになります。

使い方は、
範囲をマウスで選択して、Ctrl + Tab で、書き換わります。
その時、MS ゴシック(等幅フォント）に変わります。


'//標準モジュール
Sub Auto_Open() 'ブックを開いた時に設定させる
　　Call SettingShortcutKey
End Sub

Sub SettingShortcutKey()
　　'ショートカットの設定
　　Application.OnKey "^{TAB}", "AlignmentPr"
End Sub

Sub AlignmentPr()
　Dim objRe As Object
　Dim nos() As Variant
　Dim i As Long, j As Long, Maxlen As Long
　Dim rng As Range, c As Variant
　Set objRe = CreateObject("VBScript.RegExp")
　If TypeName(Selection) = "Range" Then
　　Set rng = Selection
　　If rng.Columns.Count > 1 Then
　　 MsgBox "1列の選択に限ります。", vbExclamation
　　 Exit Sub
　　End If
　Else
　　MsgBox "範囲を指定してください。", vbExclamation: Exit Sub
　End If
　With objRe
　　.Pattern = "^(No\.*\d+)\b"
　　.Global = False: .IgnoreCase = True
　　For Each c In rng
　　ReDim Preserve nos(i)
　　 If .Test(c.Value) Then
　　　　nos(i) = .Execute(c)(0).SubMatches(0)
　　　　If Maxlen < Len(nos(i)) Then Maxlen = Len(nos(i))
　　 End If
　　 i = i + 1
　　Next c
　End With
　Dim no As String
　Set objRe = Nothing
　j = Maxlen
　i = 0
　For Each c In rng
　　no = StrConv(Format$(nos(i), String(j, "@") & "!"), vbNarrow)
　　If c.Value <> "" And Trim(no) <> "" Then
　　 With c.Offset(0, 1) '★上書きの場合は、c.Offset(0,0)　にする
　　　　.Font.Name = "MS ゴシック"
　　　　.Value = Replace(c.Value, nos(i), no, 1, 1, vbBinaryCompare)
　　 End With
　　End If
　　i = i + 1
　Next c
End Sub