配列 Sortメソッド配列変数並替(文字列可・高速・1次元編)
※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。
※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。
Sub SortMethodArrayVariable(ByRef strDataNew() As String, ByVal strDataOld As Variant) '**************************************************** 'Sortメソッド配列変数並替(文字列可・高速・1次元編) '**************************************************** 'エクセルのRangeオブジェクト使用の為65536個を超えると不可。 'ここでは[Callステートメント]による呼び出しで関数化してます。 '既存シートデータに影響が無い様、新シートを使用してます。 '新シートは使用後削除されます。 'より高速にするにはシートを予め用意しておく事です。 'ByVal strDataOld で受け取った配列を 'ByRef strDataNew() で返してます。 Dim NewSheet As Worksheet Dim ArrayMin As Long Dim ArrayMax As Long Dim i As Long Dim strDataOldDummy() As String 'Rangeオブジェクト用配列変数 Dim rngDummy As Range '画面更新しない Application.ScreenUpdating = False '新シート追加及びセット Set NewSheet = ThisWorkbook.Worksheets.Add ArrayMin = LBound(strDataOld) '受け取った配列変数最小値 ArrayMax = UBound(strDataOld) '受け取った配列変数最大値 '①受け取った配列変数をRangeオブジェクト用に配列変数を定義 ReDim strDataOldDummy((ArrayMin + 1) To (ArrayMax + 1), 0) '②返す配列変数の格納数を定義 ReDim strDataNew(ArrayMin To ArrayMax) '受け取った配列変数①をRangeオブジェクト用配列変数にコピー For i = ArrayMin To ArrayMax strDataOldDummy(i + 1, 0) = strDataOld(i) Next i With NewSheet '③Rangeオブジェクトをセット Set rngDummy = .Range(.Cells(ArrayMin + 1, 1), .Cells(ArrayMax + 1, 1)) 'セットしたRangeオブジェクト③にRangeオブジェクト用配列変数①をコピー rngDummy = strDataOldDummy '③RangeオブジェクトSortメソッド(降順) rngDummy.Sort Key1:=.Cells(1, 1), Order1:=xlDescending '返す配列変数②に格納 For i = ArrayMin + 1 To ArrayMax + 1 strDataNew(i - 1) = rngDummy(i, 1) Next i '③セット解除 Set rngDummy = Nothing End With 'マクロの実行中に特定の警告やメッセージを表示しない Application.DisplayAlerts = False NewSheet.Delete '追加した新シート削除 'マクロの実行中に特定の警告やメッセージを表示する Application.DisplayAlerts = True Set NewSheet = Nothing 'セット解除 Application.ScreenUpdating = True '画面更新する '************************** '重要引数群 '************************** 'Key1 並べ替えの最初に優先されるキーとなるフィールド｡ 'Order1 下記-Order-参照｡ 'Key2 並べ替えの 2 番目に優先されるキーとなるフィールド。 'Order2 下記-Order-参照｡ 'Key3 並べ替えの 3 番目に優先されるキーとなるフィールド。 'Order3 下記-Order-参照｡ '1以外は多次元時(3次元まで)に使用。 '-Order- '昇順に並べ替えるには、xlAscending を指定します(既定) '降順に並べ替えるには、xlDescending を指定します｡ 'Header '最初の行がタイトル行であるかどうかを指定。 'xlGuess-(自動判別)、xlNo-(タイトルなし(既定))、xlYes-(最初の行がタイトル行) 'MatchCase '大文字と小文字を区別して並べ替えるには、True を指定。 '大文字と小文字を区別しないで並べ替えるには、False を指定。 End Sub Private Sub test() Dim strFile(5) As String strFile(0) = "a" strFile(1) = "b" strFile(2) = "c" strFile(3) = "d" strFile(4) = "e" strFile(5) = "f" Dim strDataNew() As String Call SortMethodArrayVariable(strDataNew, strFile) MsgBox "最初は：" & strDataNew(LBound(strDataNew)) MsgBox "最後は：" & strDataNew(UBound(strDataNew)) MsgBox "合計数：" & UBound(strDataNew) + 1 End Sub |