Excel VBA質問箱 IV

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

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


46888 / 76732 ←次へ | 前へ→

【34811】Re:メモリ上のデータの整列について
回答  だるま WEB  - 06/2/13(月) 15:23 -

引用なし
パスワード
   ▼VBAビギナー さん:
>Sub test()
>  Dim fs As Object, f As Object, path As String, a As Integer, sortData() As String
>  path = "C:\Documents and Settings\デスクトップ\test.txt"
>  On Error GoTo Err_Proc
>    Set fs = CreateObject("Scripting.FileSystemObject")
>    Set f = fs.OpenTextFile(path, 1)    'ファイルのオープン
>    If f.AtEndOfLine = False Then      'ファイルが空であるかの判定
>    a = 0
>    Do While f.AtEndOfStream <> True
>      ReDim Preserve sortData(a) As String
>      sortData(a) = f.ReadLine
>      a = a + 1
>    Loop
>    End If
>Exit Sub
>Err_Proc:      'エラー後処理
>  MsgBox Err.Description
>  Exit Sub
>これで配列に一行分のデータをいれています。
>loop後で配列の時間部だけでソートを行してきれいにしたいのですが?

こんにちは ^d^

ファイルの読み書きはご自身でお出来になるようですので、配列のソートの部分
だけです。

各データのカンマの左側(時刻)だけを取出し、その並べ替えインデックスを
得ます。
その並べ替えインデックスを使って、元の配列を並べ替えながら別の配列に入
れます。

Sub test2()
  Dim sortData As Variant
  sortData = Array("8:00,起床", "1:00,就寝", "12:00,昼食", "10:00,学習")
  
  '===== ここから =====
  Dim Tim() As Date
  Dim C As Integer
  Dim i As Integer
  Dim p As Integer
  Dim T As String
  Dim Ndx As Variant
  Dim SortedData() As String
  
  '時刻を取出す
  C = UBound(sortData)
  ReDim Tim(0 To C)
  For i = 0 To C
    T = sortData(i)
    p = InStr(T, ",")
    Tim(i) = CDate(Left$(T, p - 1))
  Next
  
  '並べ替えインデックスを得る
  Ndx = MsCombSortI(Tim)
  
  '並べ替えて別配列に収納
  ReDim SortedData(0 To C)
  For i = 0 To C
    SortedData(i) = sortData(Ndx(i))
    Debug.Print SortedData(i)
  Next
  
End Sub

'安定化コムソート
Private Function MsCombSortI(Target As Variant) As Variant
  '昇順インデックスを返す。
  '配列引数Targetは1次元限定。
  Dim Idx() As Long
  Dim L As Long
  Dim U As Long
  Dim i As Long
  Dim gap As Long
  Dim Temp As Long
  Dim F As Boolean
  
  L = LBound(Target)
  U = UBound(Target)
  
  'インデックス初期設定
  ReDim Idx(L To U)
  For i = L To U
    Idx(i) = i
  Next
  
  gap = U - L
  F = True
  
  '並べ替え
  Do While gap > 1 Or F = True
    gap = Int(gap / 1.3)
    If gap = 9 Or gap = 10 Then
      gap = 11
    ElseIf gap < 1 Then
      gap = 1
    End If
    F = False
    For i = L To U - gap
      If Target(Idx(i)) > Target(Idx(i + gap)) Then
        Temp = Idx(i)
        Idx(i) = Idx(i + gap)
        Idx(i + gap) = Temp
        F = True
      ElseIf Target(Idx(i)) = Target(Idx(i + gap)) Then
        If Idx(i) > Idx(i + gap) Then
          Temp = Idx(i)
          Idx(i) = Idx(i + gap)
          Idx(i + gap) = Temp
          F = True
        End If
      End If
    Next
  Loop

  MsCombSortI = Idx()
End Function

0 hits

【34612】メモリ上のデータの整列について VBAビギナー 06/2/8(水) 10:06 質問
【34613】Re:メモリ上のデータの整列について MARBIN 06/2/8(水) 10:17 発言
【34633】Re:メモリ上のデータの整列について VBAビギナー 06/2/8(水) 16:37 質問
【34811】Re:メモリ上のデータの整列について だるま 06/2/13(月) 15:23 回答
【34638】Re:メモリ上のデータの整列について ichinose 06/2/8(水) 18:42 発言
【34776】Re:メモリ上のデータの整列について Hirofumi 06/2/12(日) 11:12 回答

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