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

VBA一般 VBA覚書

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

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

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

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

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

イメージはこんな感じ。

f:id:akashi_keirin:20170604082519j:plain

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

久留米（8/1）→小倉（7/29）→佐世保（7/28）

と並んでいるやつを、

佐世保（7/28）→小倉（7/29）→久留米（8/1）

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

作戦

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

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

こんな感じ。

構造体の作成

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

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

構造体配列に各人のデータをセット

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

でとりあえず５人分の配列変数を準備して、

(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

で５人分のデータを配列に格納しているだけ。

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

「wishDate1」～「wishDate3」の大小によって、構造体内の要素を入れ替える処理が必要。

メンドクサイのは、場所データ（wishPlace○）と日付データ（wishData○）をセットで入れ替えないといけない点。

アホみたいなやり方だと笑われそうだけど、次のような専用プロシージャを作った。

基本的なやり方は、入れ替え前の構造体をobjDataとすると、

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

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

リスト３
Private Sub sortDataByDate(ByRef objData As wishData)
  Dim tmpData As wishData
  With objData
    'バブルソート１回目'
    If .wishDate2 > .wishDate3 Then
      tmpData = objData    '……(1)'
      .wishPlace3 = .wishPlace2    '……(2)'
      .wishDate3 = .wishDate2    '……(3)'
      .wishPlace2 = tmpData.wishPlace3    '……(4)'
      .wishDate2 = tmpData.wishDate3    '……(5)'
    End If
    'バブルソート２回目'
    If .wishDate1 > .wishDate2 Then
      tmpData = objData
      .wishPlace2 = .wishPlace1
      .wishDate2 = .wishDate1
      .wishPlace1 = tmpData.wishPlace2
      .wishDate1 = tmpData.wishDate2
    End If
    'バブルソート３回目'
    If .wishDate2 > .wishDate3 Then
      tmpData = objData
      .wishPlace3 = .wishPlace2
      .wishDate3 = .wishDate2
      .wishPlace2 = tmpData.wishPlace3
      .wishDate2 = tmpData.wishDate3
    End If
  End With
End Sub

うーむ、我ながら吐き気を催すようなぶさいくなコードｗｗｗ

いちおう、データ入れ替えのところだけ説明します。

「バブルソート１回目」の部分、

'バブルソート１回目'
If .wishDate2 > .wishDate3 Then
  tmpData = objData    '……(1)'
  .wishPlace3 = .wishPlace2    '……(2)'
  .wishDate3 = .wishDate2    '……(3)'
  .wishPlace2 = tmpData.wishPlace3    '……(4)'
  .wishDate2 = tmpData.wishDate3    '……(5)'
End If

まず、２番目の日付と３番目の日付を比較して、２番目の方が大きかったら(1)以下で２番目の要素と３番目の要素を入れ替える。

(1)で元のデータをtmpDataに格納しておいて、
(2)、(3)で２番目だったデータを３番目のところに上書きし、
(4)、(5)でtmpDataに避難しておいたデータを用いて２番目のところに元々３番目だったデータを上書きする
という段取り。

構造体変数を引数にするときには、参照渡ししかできないみたいなので、Functionにする必要がなかった。

このプロシージャを呼び出して並べ替える。そのためのコードがコチラ。

リスト４
For i = 0 To 4
  Call sortDataByDate(wsData(i))
Next

これだけです。Forループで i 番目のwsDataを渡しています。

シートに書き出す

今回は、別の場所に転記先の表を作った。

リスト５
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
    'バブルソート１回目'
    If .wishDate2 > .wishDate3 Then
      tmpData = objData
      .wishPlace3 = .wishPlace2
      .wishDate3 = .wishDate2
      .wishPlace2 = tmpData.wishPlace3
      .wishDate2 = tmpData.wishDate3
    End If
    'バブルソート２回目'
    If .wishDate1 > .wishDate2 Then
      tmpData = objData
      .wishPlace2 = .wishPlace1
      .wishDate2 = .wishDate1
      .wishPlace1 = tmpData.wishPlace2
      .wishDate1 = tmpData.wishDate2
    End If
    'バブルソート３回目'
    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

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

おわりに

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