Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


11228 / 13646 ツリー ←次へ | 前へ→

【17308】ソート(昇順) SR2.2DET 04/8/26(木) 18:50 質問[未読]
【17311】Re:ソート(昇順) shousuke 04/8/26(木) 20:07 発言[未読]
【17312】Re:ソート(昇順) SR20DET 04/8/26(木) 20:25 お礼[未読]
【17313】Re:ソート(昇順) Hirofumi 04/8/26(木) 20:37 回答[未読]
【17315】Re:ソート(昇順) Hirofumi 04/8/26(木) 20:53 回答[未読]
【17314】Re:ソート(昇順) Ron 04/8/26(木) 20:50 回答[未読]
【17334】Re:ソート(昇順) SR20DET 04/8/27(金) 9:51 お礼[未読]

【17308】ソート(昇順)
質問  SR2.2DET  - 04/8/26(木) 18:50 -

引用なし
パスワード
   非常に基礎的なことですが…

VBAにて、
「5,4,7,6,9,2,3,1,8…」
と、値がカブらないデータを構造体に格納してます。

これを、
「1,2,3,4,5,6,7,8,9…」
と、格納し直す簡単な方法とは、どんなんがあるでしょうか?

(簡単に申しますと→知りたいのは、構造体にあるn個のデータを昇順に格納し直す方法です。)


本とかで読んでもイマイチピンときませんでした。

どなたか、ご教授願います。

【17311】Re:ソート(昇順)
発言  shousuke WEB  - 04/8/26(木) 20:07 -

引用なし
パスワード
   構造体とは配列のことでしょうか?
配列を直接並べ替える方法は私もわかりませんが...

一旦、配列をシート上に列挙し、並べ替え、もう一度
同じ配列に取り込むのであれば割と簡単と思うのですが..

【17312】Re:ソート(昇順)
お礼  SR20DET  - 04/8/26(木) 20:25 -

引用なし
パスワード
   ありがとうございます。


>構造体とは配列のことでしょうか?

んん〜正確に?申しますと、構造体内の配列ですね…

↓こんなイメージです↓

A.a(0) = 5     A.a(0) = 1
A.a(1) = 4     A.a(1) = 2
A.a(2) = 7  →  A.a(2) = 3
A.a(3) = 6     A.a(3) = 4
A.a(4) = 9     A.a(4) = 5
   :          :
   :          :

過去ログで探していたら下記のサイトが紹介されていました。
http://aitech.ac.jp/~koikelab/webp/vba/vba_9.html

この中にあるバブルソートの方法で、現在試してます。
何とかできそうです。

【17313】Re:ソート(昇順)
回答  Hirofumi  - 04/8/26(木) 20:37 -

引用なし
パスワード
   通常、VBAでは構造体と言う言い方はしないと思います(Cには有ったと思うけど)
因って、何処え、どんな形で格納しているのか解りませんが
配列のソートは、バブルソート、Quickソート、Shellソート等いろいろなアルゴリズムが有ります
1例で、Shellソートを示します

Option Explicit

Public Sub Sample()

  Dim i As Long
  Dim vntData As Variant
  
  vntData = Array(5, 4, 7, 6, 9, 2, 3, 1, 8)
  
  ShellSort vntData
  
  For i = 0 To UBound(vntData)
    Debug.Print vntData(i)
  Next i

End Sub

Public Sub ShellSort(vntList As Variant, _
          Optional lngNum As Long = -1, _
          Optional lngStart As Long = -1)

'  シェルソート

  Dim i As Long
  Dim j As Long
  Dim lngGap As Long
  Dim vntTmp As Variant
  Dim lngTop As Long
  Dim lngEnd As Long
  
  lngTop = LBound(vntList, 1)
  If lngStart > -1 Then
    If lngStart >= LBound(vntList, 1) Then
      lngTop = lngStart
    End If
  End If
  
  lngEnd = UBound(vntList, 1)
  If lngNum > -1 Then
    If lngTop + lngNum - 1 <= UBound(vntList, 1) Then
      lngEnd = lngTop + lngNum - 1
    End If
  End If
  
  lngGap = 1
  Do While lngGap < (lngEnd - lngTop + 1) \ 3
    lngGap = 3 * lngGap + 1
  Loop
  
  Do Until lngGap <= 0
    For i = lngGap + lngTop To lngEnd
      vntTmp = vntList(i)
      For j = i To lngGap + lngTop Step -lngGap
        If vntList(j - lngGap) <= vntTmp Then
          Exit For
        End If
        vntList(j) = vntList(j - lngGap)
      Next j
      vntList(j) = vntTmp
    Next i
    lngGap = lngGap \ 3
  Loop

End Sub

【17314】Re:ソート(昇順)
回答  Ron  - 04/8/26(木) 20:50 -

引用なし
パスワード
   こんにちは。
参考までに、代表的な方法を

Option Explicit
Type TestA
  a As Variant
End Type


Sub test()

  Dim TestArray As Variant
  Dim TestType As TestA
  Dim num As Long
  Dim i As Long
  Dim j As Long
  
  TestArray = Array(5, 6, 7, 1, 2, 9, 8, 4, 3)
  TestType.a = TestArray
  
  With TestType
    For i = LBound(TestType.a) To UBound(TestType.a) - 1
      For j = LBound(TestType.a) + 1 + i To UBound(TestType.a)
        num = .a(i)
        If .a(i) > .a(j) Then
          .a(i) = .a(j)
          .a(j) = num
        End If
      Next
    Next
  End With
End Sub

では。

【17315】Re:ソート(昇順)
回答  Hirofumi  - 04/8/26(木) 20:53 -

引用なし
パスワード
   だとすると、こんなかな?

Option Explicit

Type SampleData
  a(8) As Long
End Type
  
Public Sub Sample()

  Dim i As Long
  Dim usrData As SampleData
  
  With usrData
    For i = 0 To 8
      .a(i) = Choose(i + 1, 5, 4, 7, 6, 9, 2, 3, 1, 8)
    Next i
  End With
  
  ShellSort usrData
  
  With usrData
    For i = 0 To 8
      Debug.Print .a(i)
    Next i
  End With

End Sub

Public Sub ShellSort(usrList As SampleData, _
          Optional lngNum As Long = -1, _
          Optional lngStart As Long = -1)

'  シェルソート

  Dim i As Long
  Dim j As Long
  Dim lngGap As Long
  Dim lngTmp As Variant
  Dim lngTop As Long
  Dim lngEnd As Long
  
  With usrList
  
  lngTop = LBound(.a, 1)
  If lngStart > -1 Then
    If lngStart >= LBound(.a, 1) Then
      lngTop = lngStart
    End If
  End If
  
  lngEnd = UBound(.a, 1)
  If lngNum > -1 Then
    If lngTop + lngNum - 1 <= UBound(.a, 1) Then
      lngEnd = lngTop + lngNum - 1
    End If
  End If
  
  lngGap = 1
  Do While lngGap < (lngEnd - lngTop + 1) \ 3
    lngGap = 3 * lngGap + 1
  Loop
  
  Do Until lngGap <= 0
    For i = lngGap + lngTop To lngEnd
      lngTmp = .a(i)
      For j = i To lngGap + lngTop Step -lngGap
        If .a(j - lngGap) <= lngTmp Then
          Exit For
        End If
        .a(j) = .a(j - lngGap)
      Next j
      .a(j) = lngTmp
    Next i
    lngGap = lngGap \ 3
  Loop
  
  End With

End Sub

【17334】Re:ソート(昇順)
お礼  SR20DET  - 04/8/27(金) 9:51 -

引用なし
パスワード
   みなさん、いろいろとありがとうございました。

おかげさまでできました!

いろいろ勉強になりました。
これからも参考にさせて戴きます!

11228 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free