[[20180517165750]]　『並び替えの後の空白』（狭山）　ページの最後に飛ぶ

『並び替えの後の空白』（狭山）

       A      B   　   C    　　 D    　　 E・・・・・・・・・Z

 1   No    名前   　  現場　 　　種類　　　番号

 2    1     農林　　　観光地　  りんご  　　L1
 3    2     農林　　　観光地　  りんご  　　L2
 4    3     農林　　　観光地　  りんご  　　L9
 5    4     農林　　　国有地　  りんご  　　L1
 6    5     農林　　　観光地　  りんご  　　L1
 7    6     農林　　　所有地　  りんご  　　L1

 C列を基準に並び替えをおこなってC列の文字が違う場合１行の
　空白行と二重線の罫線を付けるような作業は出来るのでしょうか
 F列～Z列には全てデータが有るわけではなく空白もございます。

 ご教授いただけましたらお願いいたします。

     A      B   　   C    　　 D    　　 E・・・・・・・・・Z

 1   No    名前   　  現場　 　　種類　　　番号

 2    1     農林　　　観光地　  りんご  　　L1
 3    2     農林　　　観光地　  りんご  　　L2
 4    3     農林　　　観光地　  りんご  　　L9
 5    5     農林　　　観光地　  りんご  　　L1
==============================================================
 6   
==============================================================
 7    4     農林　　　国有地　  りんご  　　L1
==============================================================
 8   
==============================================================
 9    6     農林　　　所有地　  りんご  　　L1

 よろしくお願いいたします。

＜使用 Excel：Excel2013、使用 OS：Windows7 ＞

＞『並び替えの後の空白』

1）小計機能で小計行を仮に追加
2）ジャンプ機能で数式のある行を特定
3）特定された行についてクリア
4）同じく特定された行に罫線追加
5）小計機能解除

という流れで出来ると思います。（微調整は必要です）
各コードはマクロの記録で得られると思いますので、
それを参考に組み立てたらいいと思います。

（まっつわん） 2018/05/17(木) 17:43

実は小計が…、とか後から言われたら困りますが、単にソートしてから文字列違いの部分に行挿入するだけなら、こんな感じですかね。

 Sub test()
    Dim i As Long
    Dim iMax As Long

    Application.ScreenUpdating = False

    With ActiveSheet
        .Cells.Borders.LineStyle = xlLineStyleNone
        iMax = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.Range("C2:C" & iMax), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SetRange Range("A1:Z" & iMax)
        With .Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

        For i = .Cells(.Rows.Count, "A").End(xlUp).Row To 3 Step -1
            If .Cells(i, "C").Value <> .Cells(i - 1, "C").Value Then
                .Rows(i).Insert
                .Range(.Cells(i, "A"), .Cells(i, "Z")).Borders(xlEdgeTop).LineStyle = xlDouble
                .Range(.Cells(i, "A"), .Cells(i, "Z")).Borders(xlEdgeBottom).LineStyle = xlDouble
            End If
        Next i
    End With

    Application.ScreenUpdating = True
 End Sub
（???） 2018/05/17(木) 17:48

（???）様

早速にありがとうございます。
感動です。完璧です。

一つ教えて下さい。
今回はC列を基準なのですが他の列を基準にする場合どこを変更すればよろしいのでしょうか
よろしくお願い致します。

（狭山） 2018/05/17(木) 20:35

"C2:C" & iMax とか "C" とか、明らかにC列と判るようにコーディングしているので、そこを変えるだけかと…。質問の前に、まずは試してみてください。ブックを保存しておけば、失敗してもまた開き直せば元通りなので、失敗を恐れないこと。
（???） 2018/05/18(金) 09:02

コメント返信：

[ 一覧(最新更新順) ]

[[20180517165750]] 『並び替えの後の空白』（狭山） ページの最後に飛ぶ

[[20180517165750]]　『並び替えの後の空白』（狭山）　ページの最後に飛ぶ