[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『範囲指定して並べ替え』（チコチャン）
下記のマクロで並び替えをすると範囲がA1からE6までを指定して並べ替えをしますが
F列に〇を入力するとA5からE6(実際は100行くらいあります）を範囲指定して並べ替える様にしたいです。
ご教示いただきたく投稿いたしました。
よろしくお願いいたします。
Sub 区分順_年齢順()
Range("A1").Sort _
Key1:=Range("D1"), _
Order1:=xlAscending, _
Key2:=Range("E1"), _
Order2:=xlDescending, _
Header:=xlYes
End Sub
顧客NO 氏名 フリガナ 区分 年齢 F列 1 正木 希海 マサキ ノゾミ レギュラー 30 2 野本 聡 ノモト サトシ ゴールド 44 3 西野 章子 ニシノ アキコ プレミアム 22 4 久野 正行 クノ マサユキ レギュラー 23 〇 5 茂木 里美 モテギ サトミ ゴールド 55
＜ 使用 Excel：Excel2013、使用 OS：Windows8 ＞
です。
（マナ） 2019/10/05(土) 22:56
だから、ちゃんと並べ替え範囲を指定すればよいです。
提示された例の場合の並べ替え範囲はどうなりますか。
＞Range("A1").Sort _
これだと、１行目からになって当然です。
（マナ） 2019/10/06(日) 12:29
Sub データの並べ替え_区分順_年齢順()
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("D1"), _
SortOn:=xlSortOnValues, Order:=xlAscending
.SortFields.Add Key:=Range("E1"), _
SortOn:=xlSortOnValues, Order:=xlDescending
.SetRange Selection
.Apply
.Header = xlNo
.Apply
End With
End Sub
（チコチャン） 2019/10/06(日) 23:57
質問が変わっていますけど、 最初の質問の回答として・・
F列を上から走査して、○ が見つかればその次の行から下をソート 見つからなければ表全体をソート しています。
Sub Macro1()
Dim myRng As Range
Dim myFR As Range
Dim myTxt As String
myTxt = "○"
With ThisWorkbook.Worksheets("Sheet1")
Set myFR = .Range("A1").CurrentRegion.Offset(, 5).Resize(, 1) _
.Find(What:=myTxt, After:=.Range("F1"), LookIn:=xlValues, SearchDirection:=xlNext)
If myFR Is Nothing Then
.Range("A1").Sort _
Key1:=.Range("D1"), Order1:=xlAscending, _
Key2:=.Range("E1"), Order2:=xlDescending, _
Header:=xlYes
Else
With .Range("A1").CurrentRegion
.Offset(myFR.Row).Resize(.Rows.Count - myFR.Row).Sort _
Key1:=myFR.Offset(1, -2), Order1:=xlAscending, _
Key2:=myFR.Offset(1, -1), Order2:=xlDescending, _
Header:=xlNo
End With
End If
End With
End Sub
（渡辺ひかる） 2019/10/07(月) 10:08
1）表全体のセル範囲を取得
2）表の一番右側の列の最後のセルから上に見て行って何か入っているセルを探す。
3）見つけたセルから表の最後のセル範囲の
5列左から、5列分
これが並び替えしたい範囲ではないですか？
そして、
その時印が見つからなければ、
1行目はタイトル行として並び替え、
それ以外はタイトル行なしで並び替え。
そういうことを、VBAで書くと以下。
Sub test()
Dim rngTop As Range
Dim rngBottom As Range
Dim rngTarget As Range
Dim lngFlg As Long
With ActiveSheet.Range("A1").CurrentRegion.Resize(, 6)
Set rngBottom = .Cells(.Cells.Count).End(xlUp)
End With
Set rngTop = rngBottom.End(xlUp)
Set rngTarget = Application.Range(rngTop, rngBottom).Offset(, -5).Resize(, 5)
If rngTop.Row = 1 Then
lngFlg = xlYes
Else
lngFlg = xlNo
End If
With rngTarget
.Sort .Range("D1"), xlAscending, _
.Range("E1"), , xlDescending, , , _
lngFlg
End With
End Sub
他の表現方法や、もっと効率のいい方法もあるかも知れませんし、
表の位置が変更になった時に、コードの変更が
最小限になるような書き方もあるかも知れませんが、
まずは、セルの位置を相対位置で表現できるようになると、
考え方が楽になるかなと思います。
（まっつわん） 2019/10/07(月) 11:51
やりたかった事が出来ました。
実際のシートへ当てはめてみます。ありがとうございました。
（チコチャン） 2019/10/07(月) 23:26
実際のシートはAE列まであるので下記の様に変更したのですが反映されませんが
他も変更するのでしょうか？宜しくお願いします。
Set myFR = .Range("A1").CurrentRegion.Offset(, 31).Resize(, 1) _
.Find(What:=myTxt, After:=.Range("AF1"), LookIn:=xlValues, SearchDirection:=xlNext)
（チコチャン） 2019/10/08(火) 20:16
＞実際のシートはAE列まであるので
シート状態が、最初の質問となにが変わっているか厳密に確認してください
AE列までの間に、空白列とかはありませんか？
こちらでAE列までのデータを作成し、 質問者さんの修正通りにコードを変えて AF列の適当なセルに○を入力して実行したら D列、E列をキーとしてソートされました。
反映されないというのはどういうことでしょうか。
○とするところを 〇（漢数字）になっているとかはありませんよね？
ちなみに
まっつわんさんのコードのほうがすっきりしていると思いますが、そちらはどうでしたか？
（渡辺ひかる） 2019/10/09(水) 13:01
すみません
○があった場合 私のコードだと
○が入力されている列の、1列前、2列前をキーとしてソートしています。
＞ Key1:=myFR.Offset(1, -2), Order1:=xlAscending, _ ＞ Key2:=myFR.Offset(1, -1), Order2:=xlDescending, _
この部分ですが、-2、-1を修正してください。
（渡辺ひかる） 2019/10/09(水) 13:14
＞空白あります。その場合はどうしたらいいのでしょうか？
一行目に見出しだけも入れてくれて空白列を解消できると、そのまま使えるのですが、 それがダメな場合は以下ですね 行数はA列でカウントしています
Sub Macro1()
Dim myRng As Range
Dim myFR As Range
Dim myTxt As String
Dim myEndRow As Long
myTxt = "○"
With ThisWorkbook.Worksheets("Sheet1")
myEndRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set myRng = .Range("A1", .Cells(myEndRow, 31))
Set myFR = myRng.Offset(, 31).Resize(, 1) _
.Find(What:=myTxt, After:=.Range("AF1"), LookIn:=xlValues, SearchDirection:=xlNext)
If myFR Is Nothing Then
myRng.Sort _
Key1:=.Range("D1"), Order1:=xlAscending, _
Key2:=.Range("E1"), Order2:=xlDescending, _
Header:=xlYes
Else
With myRng
.Offset(myFR.Row).Resize(.Rows.Count - myFR.Row).Sort _
Key1:=myFR.Offset(1, -31).Range("D1"), Order1:=xlAscending, _
Key2:=myFR.Offset(1, -31).Range("E1"), Order2:=xlDescending, _
Header:=xlNo
End With
End If
End With
End Sub
（渡辺ひかる） 2019/10/09(水) 17:51
空白列ありで並べ替え出来ました。ありがとうございました。
ですが・・・
後出しで申し訳ございませんがA1からAE1までが空欄でA2からAE2までが項目がありA3からAE3までが移動させたくない関数が入っていて
A4からAE4以降を並べ替えの対象としたいです。マクロ初心者で自力で解決できそうもないので
教えていただきたい。宜しくお願いします。
（チコチャン） 2019/10/10(木) 00:59
＞Set rngBottom = .Cells(.Cells.Count).End(xlUp)
↓
Set rngBottom = .Cells(.Cells.Count)
（まっつわん） 2019/10/10(木) 08:51
Sub Macro1()
Dim myRng As Range
Dim myFR As Range
Dim myTxt As String
Dim myEndRow As Long
myTxt = "○"
With ThisWorkbook.Worksheets("Sheet1")
myEndRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set myRng = .Range("A4", .Cells(myEndRow, 31))
Set myFR = .Range("AF4").Resize(myEndRow - 3) _
.Find(What:=myTxt, After:=.Range("AF4").Offset(myEndRow - 4), LookIn:=xlValues, SearchDirection:=xlNext)
If myFR Is Nothing Then Set myFR = .Range("AF3")
End With
With myRng
.Offset(myFR.Row - 3).Resize(.Rows.Count - myFR.Row + 3).Sort _
Key1:=myFR.Offset(1, -31).Range("D1"), Order1:=xlAscending, _
Key2:=myFR.Offset(1, -31).Range("E1"), Order2:=xlDescending, _
Header:=xlNo
End With
End Sub （渡辺ひかる） 2019/10/10(木) 08:57
Sub test()
Dim rngSortArea As Range
Dim rngKey As Range
'表のデータ範囲取得
With Worksheets("Sheet1").UsedRange
Set rngSortArea = Intersect(.Cells, .Offset(3))
End With
'表の最終列の目印を検索
With rngSortArea
On Error Resume Next
Set rngKey = .Columns(.Columns.Count).SpecialCells(xlCellTypeConstants)
On Error GoTo 0
End With
'もし、目印を見つけたら並び替え範囲を限定
If Not rngKey Is Nothing Then
Set rngSortArea = Application.Range(rngKey(rngKey.Cells.Count), _
rngSortArea(rngSortArea.Rows.Count, 1))
End If
'表の並び替え（最終列は除く）
With rngSortArea
With .Resize(, .Columns.Count - 1)
.Sort .Range("E1"), xlDescending
.Sort .Range("D1"), xlAscending
End With
End With
End Sub
セル範囲の位置の指定の仕方とか参考になれば。
（まっつわん） 2019/10/10(木) 09:25
思っていた通りの事が出来ました。
本当に助かりました。ありがとうございました。
（チコチャン） 2019/10/10(木) 19:27
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.