構造体の要素を並べ替える

構造体配列の要素をパラメータの値に従ってソートする

なんかこう、仕事が泥沼で、長らく更新できませんでした。今も泥沼の最中なんですが、現実逃避して書いています。

さて、仕事で希望調査みたいなのをやった。まあ、データ集約するだけなら楽勝だったんだけれど、問題発生。

希望(日付入り)を3つ挙げる、という項目があったんだが、「第1希望~第3希望」みたいな書き方になっていたため、3つが日付順に並んでいない回答が結構あったということ。

集約したときに人によって並び順が違う、というのはあまりにブサイク。しかも後から「おい、これ日付順に並び方を統一しとかんかい」とか言われたら死ぬので、今のうちに対応しておかないと……と考えた。

イメージはこんな感じ。

f:id:akashi_keirin:20170604082519j:plain

たとえば、「中野 浩一」さんの場合だと、

久留米(8/1)→小倉(7/29)→佐世保(7/28)

と並んでいるやつを、

佐世保(7/28)→小倉(7/29)→久留米(8/1)

という順に列ごと並べ替えたいわけなんである。

作戦

で、次のような作戦を考えた。

  1. 各人のデータを構造体変数にまとめて、配列に格納する
  2. 各構造体の日付パラメータをもとに、バブルソートアルゴリズムを用いて並べ変える
  3. 表に書き出す

こんな感じ。

構造体の作成

標準モジュールの宣言セクションで以下のように設定。

リスト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とすると、

  1. objDataの2番目の日付と3番目の日付を比較する
  2. 2番目の日付の方が大きかったら、一旦tmpDataにobjDataを丸ごとコピーする
  3. objDataの2番目の場所・日付データのところに3番目の場所・日付を上書きする
  4. objDataの2番目の場所・日付データのところにtmpDataの3番目の場所・日付を上書きする
    ※これで3番目と2番目が入れ替わる。
  5. objDataの1番目の日付と2番目の日付を比較する
  6. 1番目の日付の方が大きかったら、同様にobjDataの1番目と2番目を入れ替える
    ※この段階で一番小さな日付・場所が1番目に来ている。
  7. objDataの3番目の日付と2番目の日付を比較する
  8. 2番目の日付の方が大きかったら、同様にobjDataの2番目と3番目を入れ替える
  9. 並べ替え完了

バブルソートってやつですね。

リスト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

実行結果

実行前

f:id:akashi_keirin:20170604082519j:plain

実行後

f:id:akashi_keirin:20170604082529j:plain

ちゃんと日付順に整理された。

おわりに

うーん……。このままだとまるで応用が利かないなあ。

@akashi_keirin on Twitter