[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『時間ごとに並べ替えるには･･･？』（スフレ）
並べ替えについてよろしくお願いします。
A B C D E
1 10:20 新宿
2 11:50 田町
3 09:10 新橋
4
5 16:20 東京
6 18:50 渋谷
7
8 12:00 池袋
9 10:20 目黒
A列に時刻、B列に駅名があったとした場合に、C列に時間順に並べ替えた時刻を、D列にその場合の駅名、 E列にその場合の時間差を表示するにはどのようにしたらよいのでしょうか？ ちなみに1行と9行は同じ10:20となっています。この場合の順番はどちらでもよいです。 あと、ところどころ空白のセル（上記の場合は4、7行）もあります。
A、B列を入力し終わった時点でC、D列に反映されるようにする場合はコマンドボタンなどでやるのですか･･･？
Windows2000＋Exel2000です。よろしくお願いします。
Ａ，Ｂ列はそのまま残しておく必要ありですか？ 残しておく必要がないなら 並べ替えをして、計算式（引き算）を入力すればできますね。
Ｃ，Ｄに反映するなら、マクロでＡ，Ｂ列をＣ，Ｄ列にコピーして それを並べ替えるという方法でどうでしょう。 （涼風）
関数を使う方法を考えてみました。
ＡからＣ列を作業列とし、Ｄ、Ｅ列をデータ入力列、Ｆ、Ｇ、Ｈ列に結果を表示するとします。 例示の場合、Ａ１からＡ９まで１から９の番号を入力します。
B1=COUNTIF(D$1:D1,D1) C1=(B1=0,"",D1+B1/1000000) Ｂ１，Ｃ１を下に９行までコピー
F1=IF(ISERROR(SMALL($C$1:$C$9,A1))=TRUE,"",SMALL($C$1:$C$9,A1)) G1=IF(F1="","",VLOOKUP(F1,$C$1:$E$9,3,FALSE)) Ｆ１とＧ１を下に９行までコピー
H2=IF(F2="","",F2-F1) 下に９行までコピー
(DAI)
関数を使い、同じ時間があった場合に対応するように考えてみました。
(スフレ)さんの表を使って、
C1に =IF(COUNTA($A$1:$A$9)>=ROW(),SMALL($A$1:$A$9,ROW()),"")
D1に =IF(C1="","",IF(COUNTIF($C$1:$C1,C1)>=2,INDEX($B$1:$B$9,SMALL(IF($A$1:$A$9=C1,ROW($A$1:$A$9)),COUNTIF($C$1:C1,C1))),VLOOKUP(C1,$A$1:$B$9,2,FALSE)))
D1の式はCtrl+Shift+Enterで確定してください。
E2に =IF(C2="","",C2-C1)
として、以下コピーします。いかがでしょう？ (かなれっと)
☆コピー→並び替えのほうが簡単確実だとは思いますが＾＾；
同時間が３以上の場合にも対応できるように、少々変更しました。
VBA処理です。C列の書式を「時間」にしてください。
Sub test()
Dim a, b(), x, txt As String
Dim i As Long, ii As Long, iii As Long
With ActiveSheet
a = .Range("a1", .Cells(Rows.Count, "a").End(xlUp)).Resize(, 2).Value
For i = 1 To UBound(a, 1)
If IsEmpty(a(i, 1)) Then _
txt = txt & i & ","
Next
x = Split(Left(txt, Len(txt) - 1), ",")
ReDim Preserve x(1 To UBound(x) + 1)
VSortMA a, 1, UBound(a, 1), 1
ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
For i = 1 To UBound(a, 1)
If Not IsEmpty(a(i, 1)) Then
ii = ii + 1
If Not IsError(Application.Match(CStr(ii), x, 0)) Then _
ii = ii + 1
For iii = 1 To UBound(a, 2)
b(ii, iii) = a(i, iii)
Next
End If
Next
.Range("c1").Resize(UBound(a, 1), UBound(a, 2)) = b
End With
Erase a, b, x
End Sub
Private Sub VSortMA(ary, LB, UB, ref)
Dim M As Variant, temp
Dim i As Long, ii As Long, iii As Long
i = UB: ii = LB
M = ary(Int((LB + UB) / 2), ref)
Do While ii <= i
Do While ary(ii, ref) < M
ii = ii + 1
Loop
Do While ary(i, ref) > M
i = i - 1
Loop
If ii <= i Then
For iii = LBound(ary, 2) To UBound(ary, 2)
temp = ary(ii, iii): ary(ii, iii) = ary(i, iii)
ary(i, iii) = temp
Next
ii = ii + 1: i = i - 1
End If
Loop
If LB < i Then VSortMA ary, LB, i, ref
If ii < UB Then VSortMA ary, ii, UB, ref
End Sub
(seiya)
空白行には曰くがあるような無いような・・・
（弥太郎）
'-----------------------
Sub suhure()
Dim i As Long, maxrow As Long
maxrow = Range("a" & Excel.Rows.Count).End(xlUp).Row
Cells(1, 1).Resize(maxrow, 2).Copy Destination:=Cells(1, 3)
Cells(1, 3).Resize(maxrow, 2).Sort key1:=Cells(1, 3), order1:=xlAscending
For i = 1 To Range("c" & Excel.Rows.Count).End(xlUp).Row - 1
Cells(i + 1, 5) = Cells(i + 1, 3) - Cells(i, 3)
Next i
End Sub
弥太郎さん、コード途中で終わってませんか？
Sub suhure()
Dim i As Long, maxrow As Long, lastr as range
maxrow = Range("a" & Excel.Rows.Count).End(xlUp).Row
Cells(1, 1).Resize(maxrow, 2).Copy Destination:=Cells(1, 3)
Cells(1, 3).Resize(maxrow, 2).Sort key1:=Cells(1, 3), order1:=xlAscending
For i = 1 To maxrow
If IsEmpty(Cells(i, 1)) Then
Set lastr = Cells(Rows.Count, "c").End(xlUp)
Range(Cells(i, 3), lastr).Resize(, 2).Cut _
Destination:=Cells(i, 3).Offset(1)
End If
Next
End Sub (seiya)
いや、私のんは空白行を無視して（データを詰めて）ソートしとりまんねん（笑 （弥太郎）
ははーーん、 だったら For Next loop は要らないんですね.... (seiya)
◆関数で考えて見ました！ ◆「配列数式」ではないので、式が長くなっています！ A B C D E 1 時刻 駅名 時刻 駅名 時間 2 10:20 新宿 9:10 新橋 3 11:50 田町 10:20 新宿 1:10 4 9:10 新橋 10:20 目黒 0:00 5 11:50 田町 1:30 6 16:20 東京 12:00 池袋 0:10 7 18:50 渋谷 16:20 東京 4:20 8 18:50 渋谷 2:30 9 12:00 池袋 10 10:20 目黒
◆C2=IF(ROW(A1)>COUNT($A$2:$A$100),"",INDEX($A$1:$A$101,100-LARGE(INDEX(($A$2:$A$101=SMALL($A$2:$A$101,ROW(A1))) *($A$2:$A$101<>"")*100-ROW($2:$101),0),IF(COUNTIF($A$2:$A$101,C1)=COUNTIF($C1:C$1,C1),1,ROW(A2)-ROW(A1)))))
◆D2=IF(C2="","",INDEX($B$1:$B$100,100-LARGE(INDEX(($A$2:$A$101=C2)*100-ROW($2:$101),0),COUNTIF($C$2:C2,C2))))
◆E3=IF(C3="","",C3-C2)
★下にコピー （Maron)
うん、これは時間差を出すために使うとります。
もし空白行が必要ならこんな塩梅になりますかいなぁ・・・。
もっとも空白行と思われる行にデータが入っとったらオジャンですけどな（笑
（弥太郎）
'------------------------
Sub suhure1()
Dim i As Long, maxrow As Long
Dim n As Integer, j As Integer, blnk As Integer
Dim tbl()
Application.ScreenUpdating = False
maxrow = Range("a" & Excel.Rows.Count).End(xlUp).Row
Cells(1, 1).Resize(maxrow, 2).Copy Destination:=Cells(1, 3)
blnk = Cells(1, 1).Resize(maxrow).SpecialCells(xlCellTypeBlanks).Count
Do While maxrow > i
i = i + 1
If Cells(i, 1) = "" Then
ReDim Preserve tbl(n)
tbl(n) = i
n = n + 1
Rows(i).EntireRow.Delete
maxrow = maxrow - 1
i = i - 1
End If
If blnk <= n Then Exit Do
Loop
Cells(1, 3).Resize(maxrow, 2).Sort key1:=Cells(1, 3), order1:=xlAscending
For i = 1 To maxrow - 1
Cells(i + 1, 5) = Cells(i + 1, 3) - Cells(i, 3)
Next i
If n > 0 Then
For i = 0 To UBound(tbl)
Rows(tbl(i) + j).EntireRow.Insert
j = j + 1
Next i
End If
Application.ScreenUpdating = True
End Sub
ほないに大層なマクロで無うてええんやがな、ハハ・・
（弥太郎）
'---------------------
Sub suhure2()
Dim i As Long, maxrow As Long
Application.ScreenUpdating = False
maxrow = Range("a" & Excel.Rows.Count).End(xlUp).Row
Cells(1, 1).Resize(maxrow, 2).Copy Destination:=Cells(1, 3)
Cells(1, 3).Resize(maxrow, 2).Sort key1:=Cells(1, 3), order1:=xlAscending
For i = 1 To maxrow - Cells(1, 1).Resize(maxrow).SpecialCells(xlCellTypeBlanks).Count
Cells(i + 1, 5) = Cells(i + 1, 3) - Cells(i, 3)
If IsEmpty(Cells(i, 1)) Then
Cells(i, 3).Resize(, 3).Insert
End If
Next i
Application.ScreenUpdating = True
End Sub
良遊びました。
弥太郎さんのコード（１番目）のコードで遊んでますよ。 For Next Loop の内容を変えてあります。 (seiya)
（涼風）さんのお考えを拝借して、「新しいマクロの記録」機能を使ってマクロを作ってみました。
A B C D
1 時刻 駅名 時間差
2 1 10:20 新宿
3 2 11:50 田町
4 3 9:10 新橋
5 4
6 5 16:20 東京
7 6 18:50 渋谷
8 7
9 8 12:00 池袋
10 9 10:20 目黒
Ａ１に =COUNT(A2:A65536) Ｄ２に =IF(C2="","",IF(B1>B2,"",B2-B1))
と入力しておきます。
Ａ列に、Ａ２からデータ数分順次番号を入力します。
Macro1は、結果を得るもの、Macro2はデータの並びを元に戻すものです。
Sub Macro1()
Dim D_KAZU As Integer 'データ数
Dim R As Integer '回数
Dim RETU As String '列名
'
' Ａ列からＣ列のデータを昇順でソートする。
'
Range("A2:C2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending
'
' Ｄ２の計算式をデータ数下にコピーする。
' ワークシート上で手動でコピーするのであれば以下は不要
' （上の Dim の記述も不要。ワークシート上のＡ１の計算式も不要）
'
D_KAZU = ActiveSheet.Cells(1, 1).Value
D_KAZU = D_KAZU + 1
'
Range("D2").Select
Selection.Copy
For R = 2 To D_KAZU
RETU = "D" & R
Range(RETU).Select
ActiveSheet.Paste
Next R
Application.CutCopyMode = False
End Sub
Sub Macro2()
'
' データを元の並び順に戻す。
'
Range("A2:C2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending
End Sub
(DAI)
うわわ！こんなにレスを頂いてありがとうございます！ ひとつひとつ順番にやってみます！ 関数でもきちんとソートっぽいことができるんですね。目からうろこです。 データが膨大にあるのでマクロも参考になります！
(スフレ)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.