元のセル位置で並び替え

質問

添付画像にあるように「並び替え実行前」⇒「並び替え実行後」になる「ユーザー設定の基準」で並び替えるマクロを書きましたが、「悪い例」のようになってしまいます。

元のセル位置で並び替えるには「.SetRange Range("A1:E1")」のところを変えればいいと思い、いろいろ試してみましたが、うまくいきません。マクロを掲載しますので、修正点をご教示いただければ幸いです。

Sub Macro1()
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add _
Key:=Range("A1"), _
Order:=xlAscending, _
CustomOrder:="松,竹,梅", _
DataOption:=xlSortNormal

With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A1:E1")
.Header = xlNo
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
End Sub

回答No.1

SI299792 · ベストアンサー

そのような並べ方をするのは不可能です。
並べ替えの後
　　[E1] = [C1]
　　[C1] = [B1]
　　[B1].ClearContents
又は
　　Dim Colu As Integer
'
　　For Colu = 3 To 2 Step -1
　　　　Cells(1, Colu).Insert xlToRight
　　Next Colu
の様にデータを移動するしかありません。

これらは元データが必ず１つ鳶の状態が前提です。
元データ位置が決まっていない場合、ソート前にデータを記憶、ソートしてから元あった位置にデータを当てはめるプログラムが必要になります。

補足

最終結果が添付画像の「並び替え実行後」のようになればいいので、これで充分です。ありがとうございました。

このマクロをSheet1ではなく、アクティブシートで実行するには、
「Worksheets("Sheet1")」 を「ActiveSheet」に変えれば、よろしいでしょうか？

回答No.5

SI299792

＞「Worksheets("Sheet1") 」を「ActiveSheet」に変えれば、よろしいでしょうか？
やってみたらどうですが。
私の所ではうまくいきました。
元プログラムは、Worksheets("Sheet1")とActiveSheetが混在しているので、統一した方がいいと思います。

ちなみに、
ActiveWorkbook. も消して大丈夫です。

お礼

ありがとうございました。ご教示のおかげで、素晴らしいシステムが出来上がりました。

回答No.4

HohoPapa

誤字があったので差し替え

力技ですが、以下のコードはいかがでしょうか。
Sheet2を作業シートに使っています。

ざっくり言えば
Sheet1をSheet2に複写
Sheet2上で並べ替え
Sheet2の1行目、1列目から、
sheet1の1行目で値の埋まっているセルに順番に転記しています。 <==訂正

Sub aaa()

　Dim i As Long
　Dim j As Long
　Dim k As Long

　With ActiveWorkbook
　　'データをSheet2に複写
　　.Worksheets("Sheet2").Cells.ClearContents
　　.Sheets("Sheet1").Rows(1).Copy .Sheets("Sheet2").Rows(1)

　　'Sheet2上で並べ替え
　　With .Worksheets("Sheet2")
　　　.Sort.SortFields.Clear
　　　.Sort.SortFields.Add _
　　　　Key:=Range("A1"), _
　　　　Order:=xlAscending, _
　　　　CustomOrder:="松,竹,梅", _
　　　　DataOption:=xlSortNormal

　　　With .Sort
　　　　.SetRange Range("A1:Z1")
　　　　.Header = xlNo
　　　　.MatchCase = False
　　　　.Orientation = xlLeftToRight
　　　　.SortMethod = xlPinYin
　　　　.Apply
　　　End With
　　End With

　　i = 1
　　j = 1
　　k = 0
　　Do
　　　If .Sheets("Sheet2").Cells(1, i).Value = "" Then Exit Do
　　　k = 0
　　　j = 1
　　　Do
　　　　If .Sheets("Sheet1").Cells(1, j).Value <> "" Then
　　　　　k = k + 1
　　　　End If
　　　　If i = k Then
　　　　　.Sheets("Sheet1").Cells(1, j).Value = .Sheets("Sheet2").Cells(1, i).Value
　　　　　Exit Do
　　　　End If
　　　　j = j + 1
　　　Loop
　　　i = i + 1
　　Loop

　End With

End Sub

お礼

参考になりました。ありがとうございました。

回答No.3

HohoPapa

力技ですが、以下のコードはいかがでしょうか。
Sheet2を作業シートに使っています。

ざっくり言えば
Sheet1をSheet2に複写
Sheet2上で並べ替え
Sheet2の1行目、1列目から、
sheet1の1行目で値の埋まっていないセルに順番に転記しています。

Sub aaa()

　Dim i As Long
　Dim j As Long
　Dim k As Long

　With ActiveWorkbook
　　'データをSheet2に複写
　　.Worksheets("Sheet2").Cells.ClearContents
　　.Sheets("Sheet1").Rows(1).Copy .Sheets("Sheet2").Rows(1)

　　'Sheet2上で並べ替え
　　With .Worksheets("Sheet2")
　　　.Sort.SortFields.Clear
　　　.Sort.SortFields.Add _
　　　　Key:=Range("A1"), _
　　　　Order:=xlAscending, _
　　　　CustomOrder:="松,竹,梅", _
　　　　DataOption:=xlSortNormal

　　　With .Sort
　　　　.SetRange Range("A1:Z1")
　　　　.Header = xlNo
　　　　.MatchCase = False
　　　　.Orientation = xlLeftToRight
　　　　.SortMethod = xlPinYin
　　　　.Apply
　　　End With
　　End With

　　i = 1
　　j = 1
　　k = 0
　　Do
　　　If .Sheets("Sheet2").Cells(1, i).Value = "" Then Exit Do
　　　k = 0
　　　j = 1
　　　Do
　　　　If .Sheets("Sheet1").Cells(1, j).Value <> "" Then
　　　　　k = k + 1
　　　　End If
　　　　If i = k Then
　　　　　.Sheets("Sheet1").Cells(1, j).Value = .Sheets("Sheet2").Cells(1, i).Value
　　　　　Exit Do
　　　　End If
　　　　j = j + 1
　　　Loop
　　　i = i + 1
　　Loop

　End With

End Sub

回答No.2

imogasi

エクセルで、思考的に、標準では、並べ替えは、行方向（縦方向）データのソートです。
列方向ソートは、何かと難しい、何かと注意が必要。このことを初心者はよく知ったええで、表の設計をするべきです。特にVBAを使う場合なども。
ーー
ソートには、並べる基準となるデータがも、レコード内に必要です。
普通は（第１には、文字列の左からの文字の文字コードで行われる。数字や日本語のカナは常識的な順番（それも昇順）になるように、文字コード自体が設定（設計）してあります。
また、エクセルのユーザー定義による順番は、特別なもので、１段階前の処理がエクセルでなされているものと察します。エクセルから学習に入った初心者は、この機能が普通と考えると思うが、他のソフトやプログラムなどで実現するのは、一発では、済まない内容です。
ーー
基本論は、当初の状態を再現できるような、データを、前もってシートに作っておかないとなりません。たとえば行番号（数字か記号やカナなどで）
それに基づき、再ソートして、元に戻すほかない。
ーー
本件はユーザー定義の並び替え機能(ユーザー設定リストによる並べ替え）
を使ったのかどうかもはっきりしない。質問文に、結果の図示だけで説明できると思うのは間違いだといつも力説している。エクセルの課題で、回答をする立場になるとわかる。
ーー
操作的に直前に戻る、などは可能な場合があるが、いろいろ処理が進んだ後で当初に戻すのは、それなりの事前の仕掛けデータが必要。
ーー
「excel ユーザー定義 並べ替え」「excel ユーザー設定リスト　 並べ替え」などでGoodleででも照会し、勉強してから質問したらどうか。奥が深いか所だと思う。