電子書籍の厳選無料作品が豊富！

日付順で縦に並んでいるデータを日付+条件で横に並べ替えたい

解決済

  • 質問者：とまと0513
  • 質問日時：
  • 回答数：4件

VBA初心者です。
・Before
　　A　　　B　　　　C　　　　　D　　　　E
「日付」「No」「開始時間」「終了時間」「金額」と
縦に並んでいるデータを「日付」を1番、「No」を2番の基準で別シートへ1列に並べ替えたいです。
・After
　A　　　　B　　　　C　　　　　D　　　　E　　　　　F　　　　　G　　　　H
「日付」「No」「開始時間」「終了時間」「金額」「開始時間」「終了時間」「金額」

お店のレシートのデータがBeforeのように出てきます。
その後、ガントチャートにするので、Afterの形にしたいです。

日付やNoはその日によって違います。

恐れ入りますが、ご教示をよろしくお願いいたします。

「日付順で縦に並んでいるデータを日付+条件」の質問画像

質問者からの補足コメント

  • GooUserラック様　ご連絡ありがとうございます。早速試してみましたところ、添付いたしました画像のようになりました。

    「日付順で縦に並んでいるデータを日付+条件」の補足画像1
    No.1の回答に寄せられた補足コメントです。 補足日時：2020/01/26 02:26
    通報する

  • 別シートへNo順に1行で表したいのですが、私の設定方法が間違えているようでしたらご教示お願い致します。

    「日付順で縦に並んでいるデータを日付+条件」の補足画像2
      補足日時：2020/01/26 02:28
    通報する

  • GooUserラック様　何回もお手数をお掛けいたしまして申し訳ございません。
    ・元シート名「稼働表データ」、貼り付け先シート名「ガントチャートデータ」でお願い致します。
    ・日付には時間は含まれておりません。
    ・「No」に端数は含まれておりません。

    よろしくお願い致します。

    No.2の回答に寄せられた補足コメントです。 補足日時：2020/01/26 03:01
    通報する
通報する

この質問への回答は締め切られました。

質問の本文を隠す

A 回答 (4件)

No.4ベストアンサー

No.3 訂正です


※ ソート前に「日付」は時間部分をカット「No」は端数をカットした方が間違いないので以下に差替えてみて下さい。
※ まだ同じ「日付」「No」で行が別れてしまうのならば、AとB列だけ見えれば良いのでそこだけを図で提示して下さい。（図の大きさですが長辺が500ピクセルを超えると勝手に縮小されるので、なるべくそれに収まるようにトリミングして下さい）

Sub Sample()

Dim 元行 As Long
Dim 先行 As Long
Dim 先列 As Long
Dim 終行 As Long
Dim 日付 As Date
Dim ワークシート As Worksheet
　For Each ワークシート In Worksheets
　　If ワークシート.Name = "ガントチャートデータ" Then
　　　Application.DisplayAlerts = False
　　　Sheets("ガントチャートデータ").Delete
　　　Application.DisplayAlerts = True
　　　Exit For
　　End If
　Next
　Sheets("稼働表データ").Copy After:=Sheets(Sheets.Count)
　ActiveSheet.Name = "ガントチャートデータ"
　終行 = Cells(Rows.Count, 1).End(xlUp).Row
　For 元行 = 1 To 終行
　　Cells(元行, 1).Value = Int(Cells(元行, 1).Value)
　　Cells(元行, 2).Value = Int(Cells(元行, 2).Value)
　Next
　Cells.Sort _
　　Key1:=Range("A1"), Order1:=xlAscending, _
　　Key2:=Range("B1"), Order2:=xlAscending, _
　　Key3:=Range("C1"), Order3:=xlAscending, _
　　Header:=xlNo
　終行 = Cells(Rows.Count, 1).End(xlUp).Row
　先行 = 1
　先列 = 3
　For 元行 = 2 To 終行
　　If (Cells(元行 - 1, 1).Value) = Int(Cells(元行, 1).Value) And (Cells(元行 - 1, 2).Value) = Int(Cells(元行, 2).Value) Then
　　　先列 = 先列 + 3
　　　Range(Cells(元行, 3), Cells(元行, 5)).Cut Cells(先行, 先列)
　　Else
　　　先行 = 先行 + 1
　　　先列 = 3
　　　Range(Cells(元行, 1), Cells(元行, 5)).Copy Cells(先行, 1)
　　End If
　Next
　Range(Cells(先行 + 1, 1), Cells(終行, 5)).ClearContents
　終行 = ActiveSheet.UsedRange.Row
　終行 = Cells(Rows.Count, 1).End(xlUp).Row
　日付 = Cells(1, 1).Value
　For 元行 = 2 To 終行
　　If 日付 = Cells(元行, 1).Value Then
　　　Cells(元行, 1).ClearContents
　　Else
　　　日付 = Cells(元行, 1).Value
　　End If
　Next
　MsgBox ("終了しました")

End Sub
    • good
    • 0
    • 件
通報する
この回答へのお礼

GooUserラック様　
ありがとうございます。思っていた通りのデータになりました。
大変助かります。
また何かございましたら是非ともお願いいたします。

通報する
お礼日時：2020/01/26 03:57

No.3

とりあえず以下でお試しください。


※ 比較前に「日付」は時間部分をカット「No」は端数をカットしてます

Sub Sample()

Dim 元行 As Long
Dim 先行 As Long
Dim 先列 As Long
Dim 終行 As Long
Dim 日付 As Date
Dim ワークシート As Worksheet
　For Each ワークシート In Worksheets
　　If ワークシート.Name = "ガントチャートデータ" Then
　　　Application.DisplayAlerts = False
　　　Sheets("ガントチャートデータ").Delete
　　　Application.DisplayAlerts = True
　　　Exit For
　　End If
　Next
　Sheets("稼働表データ").Copy After:=Sheets(Sheets.Count)
　ActiveSheet.Name = "ガントチャートデータ"
　Cells.Sort _
　　Key1:=Range("A1"), Order1:=xlAscending, _
　　Key2:=Range("B1"), Order2:=xlAscending, _
　　Key3:=Range("C1"), Order3:=xlAscending, _
　　Header:=xlNo
　終行 = Cells(Rows.Count, 1).End(xlUp).Row
　For 元行 = 1 To 終行
　　Cells(元行, 1).Value = Int(Cells(元行, 1).Value)
　　Cells(元行, 2).Value = Int(Cells(元行, 2).Value)
　Next
　先行 = 1
　先列 = 3
　For 元行 = 2 To 終行
　　If (Cells(元行 - 1, 1).Value) = Int(Cells(元行, 1).Value) And (Cells(元行 - 1, 2).Value) = Int(Cells(元行, 2).Value) Then
　　　先列 = 先列 + 3
　　　Range(Cells(元行, 3), Cells(元行, 5)).Cut Cells(先行, 先列)
　　Else
　　　先行 = 先行 + 1
　　　先列 = 3
　　　Range(Cells(元行, 1), Cells(元行, 5)).Copy Cells(先行, 1)
　　End If
　Next
　Range(Cells(先行 + 1, 1), Cells(終行, 5)).ClearContents
　終行 = ActiveSheet.UsedRange.Row
　終行 = Cells(Rows.Count, 1).End(xlUp).Row
　日付 = Cells(1, 1).Value
　For 元行 = 2 To 終行
　　If 日付 = Cells(元行, 1).Value Then
　　　Cells(元行, 1).ClearContents
　　Else
　　　日付 = Cells(元行, 1).Value
　　End If
　Next
　MsgBox ("終了しました")

End Sub
    • good
    • 0
    • 件
通報する

No.2

☆「別シートへ」と書かれていなかったので、上書きする形で作成しました。


　⇒ 了解しました後ほど修正します。元のシート名と貼り付け先のシート名を教えて下さい。

☆ 同じ「日付」の物は最初以外は空欄にした方が良いのですね？
　⇒ 了解しました後ほど修正します。

☆ 同じ「日付」「No」で行が別れてしまってますね？それぞれの数式バーの値を見て以下を確認して下さい。
　・「日付」に時間が含まれていたりしませんか？
　・「No」に端数が有るが表示形式で同じに見えている等ありませんか？
この回答への補足あり
    • good
    • 0
    • 件
通報する

No.1

こんな事でしょうか？



Sub Sample()

Dim 元行 As Long
Dim 先行 As Long
Dim 先列 As Long
Dim 終行 As Long
　Cells.Sort _
　　Key1:=Range("A1"), Order1:=xlAscending, _
　　Key2:=Range("B1"), Order2:=xlAscending, _
　　Key3:=Range("C1"), Order3:=xlAscending, _
　　Header:=xlNo
　先行 = 1
　先列 = 3
　終行 = Cells(Rows.Count, 1).End(xlUp).Row
　For 元行 = 2 To 終行
　　If (Cells(元行 - 1, 1).Value = Cells(元行, 1).Value) And (Cells(元行 - 1, 2).Value = Cells(元行, 2).Value) Then
　　　先列 = 先列 + 3
　　　Range(Cells(元行, 3), Cells(元行, 5)).Cut Cells(先行, 先列)
　　Else
　　　先行 = 先行 + 1
　　　先列 = 3
　　　Range(Cells(元行, 1), Cells(元行, 5)).Copy Cells(先行, 1)
　　End If
　Next
　Range(Cells(先行 + 1, 1), Cells(終行, 5)).ClearContents
　終行 = ActiveSheet.UsedRange.Row
　MsgBox ("終了しました")

End Sub

※「終行 = ActiveSheet.UsedRange.Row」はスクロールバーなどに使用範囲を反映させる処理、終行はただのダミーです
この回答への補足あり
    • good
    • 0
    • 件
通報する

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう！

Q質問する（無料）

関連するカテゴリからQ&Aを探す

ページトップページトップ

Q質問する（無料）

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

おすすめ情報