Excel関数で入力すると自動でセルを並べ替えできるようにしたいです

例えばABC-1〜ABC-100までの文字列が同じ列にバラバラに入力されたデータがあります(ABC-1が三つあったりABC-2が四つあったりする)。
この前提で伺いたいことは
この列のデータをABC-1〜100まで自動的に並べ替え
さらにその列に新たにABC-5と入力した時に自動で他のABC-5のデータと隣合わせに並べ替えすることはできますか？

分かり難いかと知れませんがよろしくお願いします。

No.5 回答者： WindFaller 回答日時： 2017/02/10 11:52

ご質問者さんの内容を完全に把握しているわけではありませんでしたが、以下のようなマクロを作ってみました。

VBAでは、もう使われなくなったアルゴリズムのひとつ「バブルソート」を利用しています。
「バブルソート」は見ればお分かりになるように、2次配列を対象可能なのです。
アルゴリズムは、誰が使ってもよいものとされていますし、また移植性が高いものです。

なお、ダブルクリックした後の行から並べ替えられます。
右横のどこでもよいのですが、例えば、B4 に、ABC-50 と置けば、その下から、ABC-61（51があれば51,なければ次の61)の順に出力します。

ただ、一体、なぜこのような仕様が必要になったのか、お聞かせ願えれば、幸いかと存じます。
それから、VBAで使われるアルゴリズムは、この「バブルソート」と「クイックソート」の二種類です。
ABC-1 で、文字と数字を分けるものとして、-（ハイフン)が利用されています。これは別のものにも置き換えることが可能です。
　k = InStr(1, v, "-", 1)　'文字と数字のハイフンでの区分け

'
'シートモジュール
//
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　'*並べ替えたい場所の先頭にマウスカーソルを置いて、ダブルクリックをします。
　Dim rw As Long, col As Long, x, ar()
　Dim mxIndx As Long, j As Long, k As Long, i As Long
　Dim Rng As Range, Rng2 As Range
　Dim v, num
　Dim msgRet As VbMsgBoxResult　
　If Target.Value = "" Then MsgBox "セルを一つ選んで、実行してください。", vbExclamation: Exit Sub
　rw = Target.Row
　col = Target.Column
　Set Rng = Range(Cells(rw, col), Cells(Rows.Count, col).End(xlUp)) '下から上への検索
　mxIndx = Rng.Rows.Count
　x = Rng.Value　'配列
　ReDim ar(1, mxIndx)
　i = 1
　For Each v In x
　　k = InStr(1, v, "-", 1)　'文字と数字の区分け
　　ar(0, i) = CLng(Mid(v, k + 1, 1))
　　ar(1, i) = Mid(v, 1, k)
　　i = i + 1
　Next
　Babble_Sort ar
　i = 1
　ReDim x(UBound(ar, 2))
　For i = 0 To UBound(ar, 2) - 1
　　x(i) = ar(1, i + 1) & ar(0, i + 1)
　Next
　Set Rng2 = Cells(Rows.Count, col + 1).End(xlUp)
　If Rng2.Value <> "" Then
　　j = InStr(1, Rng2.Value, "-", vbTextCompare)
　　num = Mid(Rng2.Value, j + 1)
　End If
　If Val(num) > 0 Then
　　num = Val(num)
　　rw = Rng2.Row + 1
　End If
　j = 0
　msgRet = MsgBox("書き換えてよろしいですか？" & vbCrLf & _
　"Y/上書き,N右隣に書き出し,Cancel/中止", vbYesNoCancel)
　If msgRet = vbCancel Then
　　Exit Sub
　ElseIf msgRet = vbYes Then
　　col = col - 1
　End If
　For i = 1 To mxIndx
　　If ar(0, i) > num Then
　　　Cells(rw + j, col + 1).Value = x(i - 1)
　　　j = j + 1
　　End If
　Next
　Cancel = True
End Sub
Private Sub Babble_Sort(ar As Variant)
'配列宣言をすると、引数は配列でなくてはならない
　Dim u As Long
　Dim i As Long
　Dim j As Long
　Dim t1 As Variant
　Dim t2 As Variant
　u = UBound(ar, 2)
　i = LBound(ar, 2)
　Do While i < u
　　j = u
　　Do While j > i
　　　If ar(0, j) < ar(0, i) Then '昇順
　　　　t1 = ar(0, j)
　　　　t2 = ar(1, j)
　　　　ar(0, j) = ar(0, i)
　　　　ar(1, j) = ar(1, i)
　　　　ar(0, i) = t1
　　　　ar(1, i) = t2
　　　End If
　　　j = j - 1
　　Loop
　　i = i + 1
　Loop
End Sub

No.4 回答者： GooUserラック 回答日時： 2017/02/10 02:56

☆ 数字にしてしまう場合（行が多くなければとりあえず使えるレベルです）

対象のシートモジュールに以下のコードをセットして下さい。
-----------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim 始 As Long
Dim 終 As Long
Dim 列 As Long
Dim 元 As Long
始 = 1 ' タイトル行があったらその次の行番号をセット
Application.EnableEvents = False
If Target.Count = 1 Then
元 = Target.Row
列 = Target.Column
If Cells(始, 列).Value = "" Then
始 = Cells(始, 列).End(xlDown).Row
End If
終 = Cells(Rows.Count, 列).End(xlUp).Row
With Range(Cells(始, 列), Cells(終, 列))
.Replace What:="ABC-", Replacement:=""
.Sort _
Key1:=Cells(始, 列), _
Order1:=xlAscending, _
Header:=xlNo, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin
.NumberFormatLocal = """ABC-""0"
.HorizontalAlignment = xlLeft
End With
End If
Application.EnableEvents = True
End Sub
-----------------------------------------------------------------
※ 以下のようなことをやっています。
① 入力すると、その列から「ABC-」を全て削除して数字に直す。
② 対象列の値が入っている範囲でソートをかけます。
③ 対象列の数のまま書式設定を「"ABC-"0」「左寄せ」にします。

※ 列が決まっているならば、最初に「If Target.Column <> ○ Then Exit Sub」などを入れて下さい（「○」には列番号を入れて下さい）

No.3 回答者： GooUserラック 回答日時： 2017/02/10 02:46

☆ 文字のまま処理する場合（行が余り多くなければとりあえず使えるレベルです）

対象のシートモジュールに以下のコードをセットして下さい。
-----------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim 始 As Long
Dim 終 As Long
Dim 列 As Long
Dim 元 As Long
Dim 行 As Long
始 = 1 ' タイトル行があったらその次の行番号をセット
Application.EnableEvents = False
If Target.Count = 1 Then
If Left(Target.Value, 4) = "ABC-" Then
元 = Target.Row
列 = Target.Column
If Cells(始, 列).Value = "" Then
始 = Cells(始, 列).End(xlDown).Row
End If
終 = Cells(Rows.Count, 列).End(xlUp).Row
With Range(Cells(始, 列), Cells(終, 列))
.Replace What:="ABC-", Replacement:=""
.Sort _
Key1:=Cells(始, 列), _
Order1:=xlAscending, _
Header:=xlNo, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin
End With
For 行 = 始 To 終
With Cells(行, 列)
If IsNumeric(.Value) Then .Value = "ABC-" & .Value
End With
Next
End If
End If
Application.EnableEvents = True
End Sub
-----------------------------------------------------------------
※ 以下のようなことをやっています。
① 入力すると、その列から「ABC-」を全て削除して数字に直す。
② 対象列の値が入っている範囲でソートをかけます。
③ 対象列の数字と認識出来るセルの値に「ABC-」を付け直す。

※ 列が決まっているならば、最初に「If Target.Column <> ○ Then Exit Sub」などを入れて下さい（「○」には列番号を入れて下さい）

No.2 回答者： GooUserラック 回答日時： 2017/02/10 02:09

③の並べ方ですよね。

リアルタイムで並びかえるのは③ですと数字の部分で並び替えないといけないので、スピードの問題で実は結構難しいかもしれません。

相談ですが、たとえば「ABC-1」ですが「ABC-1」と全て入力するのではなく「1」とだけ入力すれば「ABC-1」と表示されるのではダメでしょうか？入力も楽になると思うのですが…もちろん全て入力してもデータとしては数しか残らないようにして、しかもチャント「ABC-」が付いた状態で表示されるようにします。

No.1 回答者： GooUserラック 回答日時： 2017/02/09 23:01

少し勘違いしているようですが、関数では残念ながら並び替えは出来ないと思います。

マクロ（ＶＢＡ）の処理になると思いますが、それでも良いならば可能だと思います。

ところで並び替えなんですが文字列だと思うので、次の場合はどう並べ替えるのでしょうか？
番号でお答え下さい。

元データ
ABC-1
ABC-10
ABC-5
ABC-100

①
ABC-1
ABC-10
ABC-100
ABC-5

②
ABC-5
ABC-100
ABC-10
ABC-1

③
ABC-1
ABC-5
ABC-10
ABC-100

④
ABC-100
ABC-10
ABC-5
ABC-1

この回答へのお礼

調べが足りなかったらしく申し訳ございません

この例になりますと③番のようにしたいと考えております

お礼日時：2017/02/09 23:39