excel マクロでグループ内でソートしたい。見出しが上手くいきません。

おはようございます。グループ内でのソートが見出しを範囲内に設定するとB,C商品グループは上手くいきますが、見出しの下のA商品グループは上手くいきません。何か良い方法はないでしょうか。A商品は見出しと一緒にソートされる。　ソートの設定を見出しを含めるとしているためですが、他の方法で、見出しを含めずに商品名のある所のみソートする方法はないでしょうか。

質問者からの補足コメント

• 

  Private Sub CommandButton1_Click()
  zaiko = ListBox1.List(ListBox1.ListIndex, 0)
  With ActiveSheet
  Set r = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)) _
  .Find(What:=zaiko, LookIn:=xlValues, LookAt:=xlWhole, After:=Cells(Rows.Count, 1).End(xlUp))
  End With
  If Not r Is Nothing Then
  With r.End(xlDown)
  Call r.CurrentRegion.Sort(Key1:=r.Offset(, 1), Order1:=xlAscending)
  End With
  End If
  End

  
    補足日時：2022/05/22 08:47

• 

  ユーザーホームのテキストボックスで指定した商品のグループのみ日付順にソートします。
  現在　見出しを含めるとしていますので、A商品グループをソートすると見出しが下になります。ほかの設定方法か仕方があれば教えて貰えればと思います。

    補足日時：2022/05/22 08:50

No.7 ベストアンサー 回答者： tatsumaru77 回答日時： 2022/05/22 12:34

No５です。

コメントを付加しました。
'a商品が選択された場合、ソート時に
'.Range("A2:E5").Sort key1:=.Range("B2"), Order1:=xlAscending
'となるようなソートをすることが目的
Private Sub CommandButton1_Click()
Dim zaiko As String
'商品を取り出す（a商品を取り出したと仮定して、コメントを付加）
zaiko = ListBox1.List(ListBox1.ListIndex, 0)
Dim st As Long, en As Long, wrow As Long
With ActiveSheet
'2行から最終行まで繰り返す
For wrow = 2 To .Cells(Rows.count, 1).End(xlUp).Row
'取得した商品とA列の商品が同じなら以下の処理を行う
If zaiko = .Cells(wrow, 1).Value Then
If st = 0 Then st = wrow '最初に出現したならstにその行を記憶するの最初の行が設定される
en = wrow 'enにその行を記憶(毎回更新するので最後の行が設定される)
End If
Next
'上記の結果、st=2 en=5 となる
If st <> 0 Then
Dim srg As String, krg As String
'srgへ"A2:E5"の文字列を設定する為に以下の処理をする
srg = "A" & st & ":E" & en
'krgへ"B2"の文字列を設定する為に以下の処理をする
krg = "B" & st
.Range(srg).Sort key1:=.Range(krg), Order1:=xlAscending
End If
End With
End Sub

この回答へのお礼

早速の回答ありがとうございます。これから上手く使えそうです。助かりました。

お礼日時：2022/05/22 12:49

No.6 回答者： めぐみん_ 回答日時： 2022/05/22 10:54

検証はしてないので間違ってたらスル～っと流してください。

多分こんな短くて済む訳ないですよね・・・

Dim r As Range

With ActiveSheet

Set r = .Range("A2", .Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeConstants)

r.Areas(ListBox1.ListIndex + 1).Resize(, 5).Sort Key1:=r.Cells(1, 1).Offset(, 1), Order1:=xlAscending

End With

この回答へのお礼

ありがとうございました。テストして上手くいきました。

お礼日時：2022/05/22 12:10

No.5 回答者： tatsumaru77 回答日時： 2022/05/22 10:05

No3です。

見出し行の下に１行空白を入れたくないなら（現行のフォーマット通りにしたいなら）

以下のようにしてください。
Private Sub CommandButton1_Click()
Dim zaiko As String
zaiko = ListBox1.List(ListBox1.ListIndex, 0)
Dim st As Long, en As Long, wrow As Long
With ActiveSheet
For wrow = 2 To .Cells(Rows.count, 1).End(xlUp).Row
If zaiko = .Cells(wrow, 1).Value Then
If st = 0 Then st = wrow
en = wrow
End If
Next

If st <> 0 Then
Dim srg As String, krg As String
srg = "A" & st & ":E" & en
krg = "B" & st
.Range(srg).Sort key1:=.Range(krg), Order1:=xlAscending
End If
End With
End Sub

この回答へのお礼

ありがとうございました。うまくいきました。できれば、マクロに解説つけて貰えませんか。srgソート範囲　ｋｒｇはソートキー　wrowの探し方よくわかりません。

お礼日時：2022/05/22 12:19

No.4 回答者： fujillin 回答日時： 2022/05/22 09:38

こんにちは

問題点が2つありそうに思います。

・範囲を取得する際に、CurrentRegionで取得しているので、タイトル行に隣接している2行目からのグループはタイトル行を含んでしまいます。
（これが、ご質問になっていることの原因と思います）

・実際には、ご提示のコードでは使用していませんが・・・
＞With r.End(xlDown)
End(xlDown)でグループの最後を取得するのは良い案だとは思いますが、グループが1行しかない場合には、次のグループの先頭までを選んでしまいます。

対策としては・・
◇ タイトル行の下に1行の空白行を設けることにすれば、ご提示のままのコードでもいけると思います。

◇ レイアウトをご提示のようにしたければ、Findで取得した行から次の空白行までをきちんと探すことが必要になるでしょう。
（以下では、ソートの対象をA:E列と仮定しました）
＞If Not r Is Nothing Then
以降を修正します。

・同じようにFindメソッドで空白セル探すのなら、
Set r2 = Range("A:A").Find(What:="", after:=r)
Range(r, r2.Offset(-1)).Resize(, 5).Sort _
Key1:=r.Offset(, 1), Order1:=xlAscending

・あるいは、順に空白行までを走査するなら、
For i = 1 To Rows.Count
If r.Offset(i).Value = "" Then Exit For
Next i
r.Resize(i, 5).Sort Key1:=r.Offset(, 1), Order1:=xlAscending

No.3 回答者： tatsumaru77 回答日時： 2022/05/22 09:27

現行のマクロで行うなら

1行目（見出し）と２行目の間に空白行を１行追加すれば、正しく動作するようになります。

No.2 回答者： tatsumaru77 回答日時： 2022/05/22 08:40

現在は、具体的には、どのようなマクロで、ソートしていますか。

a商品のソートならA2:E5をソート範囲にすれば良いかと。
b商品のソートならA8:E11
c商品のソートならA14:E16 になります。

No.1 回答者： mygoonickname 回答日時： 2022/05/22 08:36

おはようございます。

直接の回答ではありませんが、
どの様なマクロで結果がどの様になっているかの説明が必要かと思います。
それがあれば、良い回答が付くかと思います。