構造体の要素を並べ替える
構造体配列の要素をパラメータの値に従ってソートする
なんかこう、仕事が泥沼で、長らく更新できませんでした。今も泥沼の最中なんですが、現実逃避して書いています。
さて、仕事で希望調査みたいなのをやった。まあ、データ集約するだけなら楽勝だったんだけれど、問題発生。
希望(日付入り)を3つ挙げる、という項目があったんだが、「第1希望~第3希望」みたいな書き方になっていたため、3つが日付順に並んでいない回答が結構あったということ。
集約したときに人によって並び順が違う、というのはあまりにブサイク。しかも後から「おい、これ日付順に並び方を統一しとかんかい」とか言われたら死ぬので、今のうちに対応しておかないと……と考えた。
イメージはこんな感じ。
たとえば、「中野 浩一」さんの場合だと、
久留米(8/1)→小倉(7/29)→佐世保(7/28)
と並んでいるやつを、
佐世保(7/28)→小倉(7/29)→久留米(8/1)
という順に列ごと並べ替えたいわけなんである。
作戦
で、次のような作戦を考えた。
こんな感じ。
構造体の作成
標準モジュールの宣言セクションで以下のように設定。
リスト1
Option Explicit Public Type wishData personName As String wishPlace1 As String wishDate1 As Date wishPlace2 As String wishDate2 As Date wishPlace3 As String wishDate3 As Date End Type
構造体配列に各人のデータをセット
リスト2
Dim Sh As Worksheet Set Sh = ActiveSheet Dim wsData(4) As wishData '……(1)' Dim i As Integer 'データを配列にセット' For i = 0 To 4 '……(2)' With wsData(i) .personName = Sh.Range("S" & i + 3).Value .wishPlace1 = Sh.Range("T" & i + 3).Value .wishDate1 = Sh.Range("U" & i + 3).Value .wishPlace2 = Sh.Range("V" & i + 3).Value .wishDate2 = Sh.Range("W" & i + 3).Value .wishPlace3 = Sh.Range("X" & i + 3).Value .wishDate3 = Sh.Range("Y" & i + 3).Value End With Next
かなり原始的な書き方になっているのはご容赦ください。
(1)の
Dim wsData(4) As wishData
でとりあえず5人分の配列変数を準備して、
(2)からの11行
For i = 0 To 4 '……(2)' With wsData(i) .personName = Sh.Range("S" & i + 3).Value .wishPlace1 = Sh.Range("T" & i + 3).Value .wishDate1 = Sh.Range("U" & i + 3).Value .wishPlace2 = Sh.Range("V" & i + 3).Value .wishDate2 = Sh.Range("W" & i + 3).Value .wishPlace3 = Sh.Range("X" & i + 3).Value .wishDate3 = Sh.Range("Y" & i + 3).Value End With Next
で5人分のデータを配列に格納しているだけ。
構造体内の要素を並べ替える
「wishDate1」~「wishDate3」の大小によって、構造体内の要素を入れ替える処理が必要。
メンドクサイのは、場所データ(wishPlace○)と日付データ(wishData○)をセットで入れ替えないといけない点。
アホみたいなやり方だと笑われそうだけど、次のような専用プロシージャを作った。
基本的なやり方は、入れ替え前の構造体をobjDataとすると、
- objDataの2番目の日付と3番目の日付を比較する
- 2番目の日付の方が大きかったら、一旦tmpDataにobjDataを丸ごとコピーする
- objDataの2番目の場所・日付データのところに3番目の場所・日付を上書きする
- objDataの2番目の場所・日付データのところにtmpDataの3番目の場所・日付を上書きする
※これで3番目と2番目が入れ替わる。 - objDataの1番目の日付と2番目の日付を比較する
- 1番目の日付の方が大きかったら、同様にobjDataの1番目と2番目を入れ替える
※この段階で一番小さな日付・場所が1番目に来ている。 - objDataの3番目の日付と2番目の日付を比較する
- 2番目の日付の方が大きかったら、同様にobjDataの2番目と3番目を入れ替える
- 並べ替え完了
バブルソートってやつですね。
リスト3
Private Sub sortDataByDate(ByRef objData As wishData) Dim tmpData As wishData With objData 'バブルソート1回目' If .wishDate2 > .wishDate3 Then tmpData = objData '……(1)' .wishPlace3 = .wishPlace2 '……(2)' .wishDate3 = .wishDate2 '……(3)' .wishPlace2 = tmpData.wishPlace3 '……(4)' .wishDate2 = tmpData.wishDate3 '……(5)' End If 'バブルソート2回目' If .wishDate1 > .wishDate2 Then tmpData = objData .wishPlace2 = .wishPlace1 .wishDate2 = .wishDate1 .wishPlace1 = tmpData.wishPlace2 .wishDate1 = tmpData.wishDate2 End If 'バブルソート3回目' If .wishDate2 > .wishDate3 Then tmpData = objData .wishPlace3 = .wishPlace2 .wishDate3 = .wishDate2 .wishPlace2 = tmpData.wishPlace3 .wishDate2 = tmpData.wishDate3 End If End With End Sub
うーむ、我ながら吐き気を催すようなぶさいくなコードwww
いちおう、データ入れ替えのところだけ説明します。
「バブルソート1回目」の部分、
'バブルソート1回目' If .wishDate2 > .wishDate3 Then tmpData = objData '……(1)' .wishPlace3 = .wishPlace2 '……(2)' .wishDate3 = .wishDate2 '……(3)' .wishPlace2 = tmpData.wishPlace3 '……(4)' .wishDate2 = tmpData.wishDate3 '……(5)' End If
まず、2番目の日付と3番目の日付を比較して、2番目の方が大きかったら(1)以下で2番目の要素と3番目の要素を入れ替える。
(1)で元のデータをtmpDataに格納しておいて、
(2)、(3)で2番目だったデータを3番目のところに上書きし、
(4)、(5)でtmpDataに避難しておいたデータを用いて2番目のところに元々3番目だったデータを上書きする
という段取り。
構造体変数を引数にするときには、参照渡ししかできないみたいなので、Functionにする必要がなかった。
このプロシージャを呼び出して並べ替える。そのためのコードがコチラ。
リスト4
For i = 0 To 4 Call sortDataByDate(wsData(i)) Next
これだけです。Forループで i 番目のwsDataを渡しています。
シートに書き出す
今回は、別の場所に転記先の表を作った。
リスト5
For i = 0 To 4 With wsData(i) Sh.Range("AA" & i + 3).Value = .personName Sh.Range("AB" & i + 3).Value = .wishPlace1 Sh.Range("AC" & i + 3).Value = .wishDate1 Sh.Range("AD" & i + 3).Value = .wishPlace2 Sh.Range("AE" & i + 3).Value = .wishDate2 Sh.Range("AF" & i + 3).Value = .wishPlace3 Sh.Range("AG" & i + 3).Value = .wishDate3 End With Next
何の工夫もない書き方ですんません。
コード全体
いちおう全体を挙げておきます。
リスト全体
Option Explicit '構造体の宣言' Public Type wishData personName As String wishPlace1 As String wishDate1 As Date wishPlace2 As String wishDate2 As Date wishPlace3 As String wishDate3 As Date End Type Public Sub exchangeWishList() Dim Sh As Worksheet Set Sh = ActiveSheet Dim wsData(4) As wishData Dim i As Integer 'データを配列にセット' For i = 0 To 4 With wsData(i) .personName = Sh.Range("S" & i + 3).Value .wishPlace1 = Sh.Range("T" & i + 3).Value .wishDate1 = Sh.Range("U" & i + 3).Value .wishPlace2 = Sh.Range("V" & i + 3).Value .wishDate2 = Sh.Range("W" & i + 3).Value .wishPlace3 = Sh.Range("X" & i + 3).Value .wishDate3 = Sh.Range("Y" & i + 3).Value End With Next '構造体配列の要素並べ替え' For i = 0 To 4 Call sortDataByDate(wsData(i)) Next 'シートに書き出す' For i = 0 To 4 With wsData(i) Sh.Range("AA" & i + 3).Value = .personName Sh.Range("AB" & i + 3).Value = .wishPlace1 Sh.Range("AC" & i + 3).Value = .wishDate1 Sh.Range("AD" & i + 3).Value = .wishPlace2 Sh.Range("AE" & i + 3).Value = .wishDate2 Sh.Range("AF" & i + 3).Value = .wishPlace3 Sh.Range("AG" & i + 3).Value = .wishDate3 End With Next End Sub '並べ替え用プロシージャ' Private Sub sortDataByDate(ByRef objData As wishData) Dim tmpData As wishData With objData 'バブルソート1回目' If .wishDate2 > .wishDate3 Then tmpData = objData .wishPlace3 = .wishPlace2 .wishDate3 = .wishDate2 .wishPlace2 = tmpData.wishPlace3 .wishDate2 = tmpData.wishDate3 End If 'バブルソート2回目' If .wishDate1 > .wishDate2 Then tmpData = objData .wishPlace2 = .wishPlace1 .wishDate2 = .wishDate1 .wishPlace1 = tmpData.wishPlace2 .wishDate1 = tmpData.wishDate2 End If 'バブルソート3回目' If .wishDate2 > .wishDate3 Then tmpData = objData .wishPlace3 = .wishPlace2 .wishDate3 = .wishDate2 .wishPlace2 = tmpData.wishPlace3 .wishDate2 = tmpData.wishDate3 End If End With
End Sub
実行結果
実行前
実行後
ちゃんと日付順に整理された。
おわりに
うーん……。このままだとまるで応用が利かないなあ。