ユーザー設定リスト文字列を並び順にして列単位の並び替え(sort) Excelが落ちる原因を探れ!→ DeleteCustomList (Excel VBA)

【本日のミッション】

Excel VBAにて、ユーザー設定リスト文字列を並び順にして、列単位の並び替えをせよ。コードの書き方によってExcelが落ちる原因も探れ!

ミッションの概要

今回やりたいことは、Sheet1のユーザー設定リスト文字列「並び順」を並び順にして

←Sheet1

Sheet2のセルB1~D13を列単位での並び替えを行うことです。

←Sheet2
↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓

←Sheet2

私、これをやりたくてVBAを作ったのですが、それがどうも失敗作だったみたいで・・・。

VBAのコードを書いて保存しようとしたら、砂時計(今はクルクル)が回り始めExcelが落ち、何事もなかったかのようにExcelが再起動。ファイルは保存されていません。

私がこの現象に陥ったのはExcel2016Excel2013です。

環境によっては「MicroSoft Excelは 動作を停止しました」が出る場合もあるようです。

CustomListを使った並び替え これだと失敗する

原因がわかるまで、Excel 2003までの並び替えの書き方、Excel 2007以降の並び替えの書き方、いろいろ試しました。

↓Excel 2007以降のSortオブジェクトを使った失敗作です。

Sub よくない並び替え1()
    Dim lt As Range         '並び順リストセル
    Dim ws As Worksheet     '並び替えを行うシート
    Dim ran As Range        '並び替えを行うセル
    Dim lt_no As Integer    '並び替えリスト番号
    
    Set ws = Worksheets("sheet2")                '並び替えを行うシート
    Set lt = Worksheets("sheet1").Range("A2:A4") '並び順リストセル
    Set ran = ws.Range("B1:D13")                 '並び替えを行うセル

    Application.AddCustomList listarray:=lt      'ltをユーザー設定リストに登録
    lt_no = Application.CustomListCount          '登録したユーザー設定リストの番号

    With ws.Sort
        .SortFields.Clear                   '既存の並べ替え条件をクリア
        .SortFields. _
            Add Key:=ran(1, 1), _
            Order:=xlAscending, _
            CustomOrder:=lt_no              'lt_noをユーザー設定の並べ替え基準にセット
        .SetRange ran                       '並び替えを行うセルを指定
        .Header = xlNo                      '見出しを設定しない
        .Orientation = xlSortRows           '列単位で並び替え
        .Apply                              '並び替え実行!
    End With
    
    Application.DeleteCustomList lt_no      '登録したユーザー設定リストを削除
End Sub

↓Excel 2003までのRangeオブジェクトのSortメソッドを使った失敗作です。

Sub よくない並び替え2()
    Dim lt As Range         '並び順リストセル
    Dim ws As Worksheet     '並び替えを行うシート
    Dim ran As Range        '並び替えを行うセル
    Dim lt_no As Integer    '並び替えリスト番号
    
    Set ws = Worksheets("sheet2")                '並び替えを行うシート
    Set lt = Worksheets("sheet1").Range("A2:A4") '並び順リストセル
    Set ran = ws.Range("B1:D13")                 '並び替えを行うセル

    Application.AddCustomList listarray:=lt   'ltをユーザー設定リストに登録
    lt_no = Application.CustomListCount       '登録したユーザー設定リストの番号

    ran.Sort _
        key1:=ran(1, 1), _
        Order1:=xlAscending, _
        OrderCustom:=lt_no + 1, _
        Header:=xlNo, _
        MatchCase:=False, _
        Orientation:=xlSortRows
    
    Application.DeleteCustomList lt_no      '登録したユーザー設定リストを削除

End Sub

Excelが落ちた原因 「DeleteCustomList」

Excel 2007以降、Excel 2003まで、どちらのSortの書き方でも、Excelが落ちる原因となっているのはこの部分でした。

Application.DeleteCustomList lt_no

Excel2003までは

  1. 文字列をユーザー設定リストに登録
  2. 並び替え
  3. 登録していたユーザー設定リストを削除

という処理が必要でした。

Excel 2007以降はカスタム文字列で並び替えを行う際、ユーザー設定リストに登録していなくても並び替えできるようになったのです。

ユーザー設定リストを登録しなくていいので、最後のユーザー設定リストの削除の処理「Application.DeleteCustomList」も必要なくなります。

ちなみにこの失敗VBAですが、xls形式(Exsel97-2003)だと正常に保存されます。

次にユーザー設定リストを使わない、カスタム文字列での並び替えの方法をご紹介します。

■■■スポンサーリンク■■■

CustomOrderを使った並び替え これだとうまくいく!

ユーザー設定リストの追加「AddCustomList」、ユーザー設定リストの削除「DeleteCustomList」を使わず、ユーザー設定リスト文字列を指定する「CustomOrder」を使うことで、処理も保存も成功しました!

Sub 成功する並び替え()
    Dim lt              '並び順リスト
    Dim ws As Worksheet '並び替えを行うシート
    Dim ran As Range    '並び替えを行うセル
    
    Set ws = Worksheets("sheet2")   '並び替えを行うシート
    lt = WorksheetFunction.Transpose(Worksheets("sheet1").Range("A2:A4"))   '並び順リス
    Set ran = ws.Range("B1:D13")    '並び替えを行うセル

    With ws.Sort
        .SortFields.Clear
        .SortFields. _
            Add Key:=ran(1, 1), _
            Order:=xlAscending, _
            CustomOrder:=Join(lt, ",")
        .SetRange ran
        .Header = xlNo
        .Orientation = xlSortRows
        .Apply
    End With
End Sub

Excel 2007以降の並び替えの方法

青文字のところで、並び替えの条件削除→新しい条件の指定をしています。
橙文字のところで並び替えの実行をしています。

With ws.Sort
    .SortFields.Clear
    .SortFields. _
        Add Key:=ran(1, 1), _
        Order:=xlAscending, _
        CustomOrder:=Join(lt, ",")
    .SetRange ran
    .Header = xlNo
    .Orientation = xlSortRows
    .Apply
End With

まずは、前回ソートした条件を、全て削除します。前の条件が残っていると、誤った並び替えになる可能性があるからです。

    .SortFields.Clear・・・並び替え条件の削除

次に、今回の並び替え条件を指定します。見やすいように改行しています。

    .SortFields. _
        Add Key:=ran(1, 1), _ ・・・・・・・並び替えの基準セルの指定(セルB1)
        Order:=xlAscending, _ ・・・・・・・並び替えの順序の指定(昇順)
        CustomOrder:=Join(lt, ",") ・・・・ユーザー設定の並び替え文字列の指定

今回の並び替えの対象セルは「ran = ws.Range(“B1:D13”)」としていますので、並び替え基準セルran(1, 1)はセルB1になります。

CustomOrder:=Join(lt, “,”)については、後程詳しく説明させていただきます。

今回は、条件キーが1つだけなのですが、2つ以上ある場合は

.SortFields.Add Key:=Range(“D1”),order:=xlAscending
.SortFields.Add Key:=Range(“C1”),order:=xlDescending
.SortFields.Add Key:=Range(“Z1”),order:=xlDescending

という風に、複数の条件キーを増やすことができます。

.SortFields.Clear」は並べ替えダイアログで[レベルの削除]ボタンで条件の削除
.SortFields.Add」は並べ替えダイアログで[レベルの追加]ボタンで条件の追加

を行う動作と同じですね。

【並び替え条件】

並び替え条件は他にも色々設定が可能です。

引数説明
Key並び替えの基準セル。
SortOn並び替えのタイプ。

定数説明
xlSortOnValues(規定値)0セル内のデータで並び替え。
xlSortOnCellColor1セルの背景色で並び替え。
xlSortOnFontColor2セルの文字色で並び替え。
xlSortOnIcon3条件付き書式のアイコンで並び替え。
Order並び替えの順序

定数説明
xlAscending(規定値)1昇順
xlDescending2降順
CustomOrderユーザー設定の並び替え基準。
文字列で指定します。
DataOption数値と文字列の並び替え基準。

定数説明
xlSortNormal(規定値)0数値と文字列を別々に並び替えます。
xlSortTextAsNumbers1文字列を数値とみなして並び替えます。

後半は並び替え実行に関する記述になります。

    .SetRange ran ・・・並び替えを行うセル範囲(ran)を設定しています。
    .Header = xlNo・・・先頭列を見出し列と見なしません。
    .Orientation = xlSortRows・・・並び替えの方向を列単位(左から右)とします。
    .Apply・・・並び替えを実行します!

【Sortオブジェクトのメンバー】
上記以外にも、色々な設定ができます。

メソッドSetRange並び替えを行うセル範囲を設定します。
Apply並び替えを実行します!
プロパティHeader最初の行に見出しが含まれるかを指定します。

定数説明
xlGuess0Excel が自動的に設定。
xlYes1見出しとして使用する。
xlNo(既定値)2見出しとして使用しない。
(指定セル範囲全てが並び替えの対象)
MatchCase大文字と小文字を区別する場合:True
区別しない場合: False
Orientation並び替えの方向を指定します。

定数説明
xlSortColumns
(xlTopToBottom)(既定値)
1行単位で並び替え(上から下)
xlSortRows
(xlLeftToRight)
2列単位で並び替え(左から右)
SortMethod漢字の並び替え方法を指定します。

定数説明
xlPinYin(既定値)1ふりがなを使って並び替え。
xlStroke2ふりがなを使わずに並び替え。
■■■スポンサーリンク■■■

TransposeとJoinを使って、並び替えに使えるユーザー設定リスト文字列を作成

本来、「CustomOrder」を使ってユーザー設定リスト文字列を指定する場合、下記のようなカンマ区切りの文字列での指定となります。

Sort.SortFields.Add Key:=ran(1, 1), _
            Order:=xlAscending, _
            CustomOrder:="那覇,東京,札幌"

今回は、その文字列をSheet1にあるセルから持ってくるのですが、少し工夫が必要です。

←Sheet1

Joinの使い方は、下記の通りなので

Join(文字列型の配列変数,要素を結合するときの、要素間の区切り文字の指定)
lt = Worksheets("sheet1").Range("A2:A4")  'Sheet1のA2:A4を配列変数ltにセット
CustomOrder:=Join(lt,",")                 'ltをカンマ区切り文字列に変換

としてみたのですが「実行時エラー5 プロシージャの呼び出し、または引数が不正です。」とエラーが出てしまいました。

Join関数の引数「文字列型の配列変数」なのですが、1次元配列しか対応していなかったんです!!

lt = Worksheets("sheet1").Range("A2:A4")

で配列変数ltに入っていたのは2次元配列でした。

これをTransposeを使って1次元配列にします。

lt = WorksheetFunction.Transpose(Worksheets("sheet1").Range("A2:A4"))

長い道のりでしたが、ようやくユーザー設定リスト文字列を並び順にして列単位の並び替えが無事終了です(#^.^#)

【参考】

指定したフォルダ内のファイル名全てを取得(Excel VBA)
変数でよく使われる「buf」「tmp」の意味
Dir関数が取得するファイルの順番
指定したフォルダ内のフォルダ名全てをGetAttrを使って「エラー53 ファイルが見つかりません。」を出さずに取得(Excel VBA)
GetAttr関数とAnd演算子でビット演算の使い方 ファイルやフォルダの属性を取得
フォルダ名だけを取得したい時に出てくる 「.」 と 「..」 とは?
指定したフォルダ内とサブフォルダ内全てのファイル名を取得(Excel VBA)
CreateObject(“Scripting.FileSystemObject”) を使ってサブフォルダを取得
再帰処理とは?フォルダ内とサブフォルダ内全てのファイル名を取得(Excel VBA)
指定したフォルダ内のサブフォルダのフォルダ名を全部取得(Excel VBA)
再帰処理とは?フォルダ内のサブフォルダのフォルダ名を全部取得(Excel VBA)
参照渡し「ByRef」と値渡し「ByVal」の違い(Excel VBA)
ファイルのフルパスからファイル名のみを取得 InStrRev関数(Excel VBA)
指定したフォルダの全ての階層のフォルダ名・サブフォルダ名・ファイル名を取得(Excel VBA)
FileSystemObjectとは?CreateObject 関数 FolderExists・GetFolderの使い方
FileSystemObject CreateObject関数を使う方法・ 参照設定を使う方法 違いを理解してエラー防止
再帰処理とは?指定したフォルダの全ての階層のフォルダ名・サブフォルダ名・ファイル名を取得(Excel VBA)
ファイルのフルパスからファイル名のみを取得 Split関数(Excel VBA)
Callステートメントとは 引数 括弧()の使い方(Excel VBA)
指定したフォルダ内から「特定の文字を含まないファイル名」を取得(Excel VBA)
ワイルドカードとは。使い方いろいろ。(Excel)
Dir関数の使い方。ファイル名やフォルダ名の取得方法。(Excel VBA)
指定したフォルダのファイル名を取得し、そのファイル名を一括で変換(Excel VBA)
Excel起動時に「コンパイルエラー」。64ビット システムで Declareステートメントに、PtrSafe属性を設定(Excel VBA )
「ファイルを開く」ダイアログボックス から ファイル名を取得(Excel VBA)
「ファイルを開く」ダイアログボックス から 複数 ファイル名を取得(Excel VBA)
指定フォルダ内のサブフォルダ全てをフォルダ構成のみ(空フォルダ)を別フォルダにコピー(Excel VBA)
再帰処理とは?指定フォルダ内のサブフォルダ全てをフォルダ構成のみ(空フォルダ)を別フォルダにコピー(Excel VBA)

■■■スポンサーリンク■■■