[[20200514123454]]　『至急、関数かマクロ教えて下さい！』（みい）　ページの最後に飛ぶ

『至急、関数かマクロ教えて下さい！』（みい）

こんにちは、エクセル初心者です。

sheet1に入っている大量のデータを、
新しくシートを日付別に作成してそのシートにふり分けていきたいです。

元データの内容はA列からI列まで1行ずつデータが入っており、
H列に日付（2020/3/5等）が入っております。
これをH列の日付ごとにシートを作成したいです。

手順として、
新しくシートを作成する
新しいシート名を日付にする（元データの日付の書き方は変更可能）
元データの該当する日付のものをシートに割り振る

今まで手作業でやっておりましたが
効率の良いやり方を探してます。
関数でもマクロでもわかる方教えて貰えると助かります。
説明下手ですいません。

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

＜使用 Excel：Office365、使用 OS：Windows10 ＞

[[20200514120431]]

 に回答ついてますよ

 現状で手作業でできてたるのに、なんで至急なんでしょうね？
 多くの質問者さんの中で、自分が一番急いでいるとなぜ思うのか不思議です
（´・ω・`） 2020/05/14(木) 12:50

効率を考えたら、誰かしらにVBAを習得させるとか、金を払ってどこかに作らせるかでしょうね。
単に面倒くさいだけでは。
（効率って何でしょうか？） 2020/05/14(木) 13:21

 ＞H列に日付（2020/3/5等）が入っております。

 日付は昇順になっているんですか？

（半平太） 2020/05/14(木) 13:37

Sub main()

    Dim c As Range
    For Each c In Sheets("Sheet1").Range("H:H").SpecialCells(2)
        If IsDate(c.Value) Then
            Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = Format(c.Value, "yyyy年mm月dd日")
            ActiveSheet.Range("A1:I1").Value = Sheets("Sheet1").Range("A" & c.Row & ":I" & c.Row).Value
        End If
    Next c
End Sub
（mm） 2020/05/14(木) 13:41

日付はバラバラでデータは毎日更新されていきます。
（みい） 2020/05/14(木) 14:20

 Sheet1の1行目にタイトルが無い、と言う前提です（全部データ）

 Sub destributeByDates()
     Dim cel As Range
     Dim preName As String
     Dim tgtName As String
     Dim tgtCount As Long

     Application.ScreenUpdating = False

     Sheets("Sheet1").Copy After:=Sheets(Sheets.Count)

     With ActiveSheet '作業用(後で削除

         .Name = "作業"
         .Sort.SortFields.Clear
         .Sort.SortFields.Add Key:=.Range("H2"), SortOn:=xlSortOnValues, Order:=xlAscending
         With .Sort
             .SetRange Range("A1").CurrentRegion
             .Header = xlNo 'xlYes
             .Orientation = xlTopToBottom
             .Apply
         End With
     End With

     preName = ""
     For Each cel In Sheets("作業").Range("H:H")
         If cel = "" Then
             Application.DisplayAlerts = False
             Sheets("作業").Delete
             Application.DisplayAlerts = True
             Exit Sub
         Else
             tgtName = Format(cel.Value, "yyyymmdd")
             If preName <> tgtName Then
                 preName = tgtName

                 On Error Resume Next
                 Worksheets(tgtName).Select
                 If Err.Number <> 0 Then
                     Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = tgtName
                 End If
                 On Error GoTo 0

                 With Worksheets(tgtName)
                     .Cells.ClearContents
                     tgtCount = Application.CountIf(Sheets("作業").Columns("H"), CDbl(cel.Value))
                     cel.EntireRow.Cells(1, 1).Resize(tgtCount, 9).Copy .Range("A1")
                 End With
             End If
         End If
     Next cel

     Application.ScreenUpdating = False
 End Sub

（半平太） 2020/05/14(木) 15:38

半平太さん

ありがとうございます！
すごいですね。すごく参考になりました！
（みい） 2020/05/14(木) 17:25

 こといらはどうなりました？

[[20200514120431]]　『【至急】元データをシートに振り分ける関数orマク』（みい）
（通りすがり） 2020/05/14(木) 17:27

コメント返信：

[ 一覧(最新更新順) ]

[[20200514123454]] 『至急、関数かマクロ教えて下さい！』（みい） ページの最後に飛ぶ

[[20200514123454]]　『至急、関数かマクロ教えて下さい！』（みい）　ページの最後に飛ぶ