文字列ソートの関数を作りたい (ID:74562)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文 下記のようなのはどうでしょう 比較結果Nullについては無視してあるので カスタマイズしてください '--------プロシージャ戻り値 Public Enum FuncRtn pnCntOK = 0 '正常終了 pnCntNotFound = 1 'DataNotFound pnCntErr = -1 'エラー pnCntQuit = -9 '異常終了 End Enum '---------ソートタイプ Public Enum SortType [-1 Asc] = -1 '昇順 [1 DESC] = 1 '降順 End Enum '*********************************************************** '[NAME ]：文字列ソート処理(nfSortStr) '[PARAMETER]：第1引数：ソート対象文字列型配列(OptionBase以上の次元が確保されている事) ' 第2引数：ソートタイプ、昇順・降順定数【SortType】 ' 第3引数：ソート後配列返却の器 ' 第4引数：文字列比較モード定数【VbCompareMethod】(任意：初期バイナリ) '[RETERN ]：0:pnCntOK-正常終了、-9:pnCntQuit-異常終了 '[FUNCTION ]：配列内の文字列データを引数形式で並び替え '*********************************************************** Public Function nfSortStr(ByRef sData() As String, _ ByVal nSort As SortType, _ ByRef sRtnData() As String, _ Optional ByVal nComp As VbCompareMethod = vbBinaryCompare) As FuncRtn Dim nCnt As Integer '対象カウンタ Dim nData As Integer '引数配列次元カウンタ Dim nIndex As Integer '対象文字列Priority Const nCntEqual As Integer = 0 '文字列比較同一時戻り値 Const nCntOptBase As Integer = -1 '比較時自分とも比較するので-1から始めます。 On Error GoTo nfSortStrErr 'エラートラップ ReDim Preserve sRtnData(UBound(sData)) '返却用配列の次元確保 For nData = 0 To UBound(sData) '引数次元全て nIndex = nCntOptBase 'Priority初期化 For nCnt = LBound(sData) To UBound(sData) '最大次元までなめる If StrComp(sData(nCnt), sData(nData), nComp) = nSort Then 'ソートタイプによる比較結果判定 nIndex = nIndex + 1 '優先順位をインクリメント ElseIf StrComp(sData(nCnt), sData(nData), _ nComp) = nCntEqual And nCnt <= nData Then '文字比較同一の場合元配列の順番を生かす(常時カウントアップ) nIndex = nIndex + 1 '優先順位をインクリメント End If Next nCnt sRtnData(nIndex) = sData(nData) '当該の順位次元に文字列格納 Next nfSortStr = pnCntOK '正常終了 Exit Function nfSortStrErr: nfSortStr = pnCntQuit '異常終了 End Function