[[20230220030902]]　『各IDを日付順に他シートに振り分けて転記したい。』（悩み多き社畜）　ページの最後に飛ぶ

『各IDを日付順に他シートに振り分けて転記したい。』（悩み多き社畜）

お世話になります。

ファイル振り分けではお世話になりました。
振り分け後のCSVデータで苦労しております。お力添えをお願いします。

抽出したCSVのデータ毎月33000行程度をデータシートに
各ID、日付順に振り分けて転記したいのです。
現状はシート1にCSVからデータを抽出した段階です。

1データは1行から35行までで、
列はA列～最大Q列まで、A列のデータは転記不要。
（データシート側に記載してある為。）
空白セル、不要なデータあり。
時折1行目から35行目まで完全に空白の列があります。
毎月3万行程度になります。

データ参考下記
A　　B　　C　　D　　E
不要日付空白空白空白
空白 ID ID 空白 ID
空白場所場所空白場所
空白単位単位空白単位
空白不要不要空白不要
1:00 0 0 空白 0
2:00 0 1 空白 0
3:00 0 0 空白 0
4:00 0 0 空白 0
5:00 0 0 空白 0
6:00 0 1 空白 0
7:00 0 0 空白 0
8:00 0 0 空白 0
9:00 0 1 空白 10
10:00 0 0 空白 10
11:00 0 0 空白 10
12:00 0 1 空白 10
13:00 0 0 空白 10
14:00 0 0 空白 10
15:00 0 1 空白 0
16:00 0 0 空白 10
17:00 0 0 空白 10
18:00 0 1 空白 0
19:00 0 0 空白 10
20:00 0 0 空白 0
21:00 0 0 空白 10
22:00 0 1 空白 0
23:00 0 0 空白 0
24:00 0 0 空白 0
不要不要不要空白不要不要
不要不要不要空白不要不要
不要不要不要空白不要不要
不要不要不要空白不要不要
不要不要不要空白不要不要
不要不要不要空白不要不要

やりたいこと、
IDに横に並べてから日付順でデータシートに転記したい。
A列はデータシート側に入力済みなので転記しない。
B列以降、各列にIDが入力されていればデータシートに転記したい。（IDがある場合は必ず2行目
各5行目の不要なデータ欄をB1日付データに変更したい。
IDが2行目にあれば5行目に必ずaccumulatorと入力されるが不要な為。

転記するときの構成はこんな感じにできれば、
1行目はA1は不要なデータ、B1は日付、それ以外は空白の為、転記しない。
B1にしか日付がないので取得の為に使用？それ以降はB1＋35の場所に日付がある。
2行目はID。データシート2行目に各ID記入済み。　振り分けに使用して転記はしない。
それ以降は2＋35の場所にIDがある。
3行目　設置場所　データシート3行目に各設置場所あり　転記しない
4行目　単位　データシート4行目に単位あり　転記しない
5行目　IDがある場合、accumulatorと入力される。B1日付データに変更して転記したい。
6行目から29行目、転記する。
30行目から35行目、不要なデータなので転記しない。

データシート構成（A列及び2行目から4行目は入力済み
A 　 B　　　　C以降2行目に各ID～EU列まで（150列）
名称　空白
ID　　　100-AA-100000（数字3桁、アルファベット2文字、数字6桁の構成
設置場所　設置場所詳細
単位　　　単位
日付　　　以下空白、各IDの下に日付と値を貼り付けていきたい。
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
日付
以降繰り返し

以上となります。

抽出済みのデータは日付順にならんでいます。
データによっては列違いで同一IDが出てくることがありますが、
日付が同じなら持っている値も同じなので上書き処理等で構いません。

マクロでやるべきか、関数で可能なのか等、
どうかお力添えをお願いします。

＜使用 Excel：Microsoft365、使用 OS：Windows11 ＞

整理のお手伝いだけでも。。。＾＾
振り分け済みシート名　1　の想像図。(￣▽￣)

     |[A]  |[B] |[C] |[D]|[E] |[F] 
 [1] |不要 |日付|    |   |    |    
 [2] |     |ID  |ID  |   |ID  |    
 [3] |     |場所|場所|   |場所|    
 [4] |     |単位|単位|   |単位|    
 [5] |     |不要|不要|   |不要|    
 [6] |1:00 |   0|   0|   |   0|    
 [7] |2:00 |   0|   1|   |   0|    
 [8] |3:00 |   0|   0|   |   0|    
 [9] |4:00 |   0|   0|   |   0|    
 [10]|5:00 |   0|   0|   |   0|    
 [11]|6:00 |   0|   1|   |   0|    
 [12]|7:00 |   0|   0|   |   0|    
 [13]|8:00 |   0|   0|   |   0|    
 [14]|9:00 |   0|   1|   |  10|    
 [15]|10:00|   0|   0|   |  10|    
 [16]|11:00|   0|   0|   |  10|    
 [17]|12:00|   0|   1|   |  10|    
 [18]|13:00|   0|   0|   |  10|    
 [19]|14:00|   0|   0|   |  10|    
 [20]|15:00|   0|   1|   |   0|    
 [21]|16:00|   0|   0|   |  10|    
 [22]|17:00|   0|   0|   |  10|    
 [23]|18:00|   0|   1|   |   0|    
 [24]|19:00|   0|   0|   |  10|    
 [25]|20:00|   0|   0|   |   0|    
 [26]|21:00|   0|   0|   |  10|    
 [27]|22:00|   0|   1|   |   0|    
 [28]|23:00|   0|   0|   |   0|    
 [29]|24:00|   0|   0|   |   0|    
 [30]|不要 |不要|不要|   |不要|不要
 [31]|不要 |不要|不要|   |不要|不要
 [32]|不要 |不要|不要|   |不要|不要
 [33]|不要 |不要|不要|   |不要|不要
 [34]|不要 |不要|不要|   |不要|不要
 [35]|不要 |不要|不要|   |不要|不要
違っていればご指摘を。
同じ感じでご希望の結果の表も、ご提示頂くと、多数
アドバイスが有るかもしれません。
momoさん　のシート整形ツールが有りますので宜しければどうぞ
http://www.excel.studio-kazu.jp/kw/20110209184943.html
です。
後
＞＞以下空白、各IDの下に日付と値を貼り付けていきたい。
は
一つのセルに日付と、値を貼り付けるのですか？？；ｗ　←おぉ要らぬお世話でした
私がご案内差し上げるという意味では御座いません。が。。。(◎_◎;)
すこぉおし興味が御座いまして、差支えなければ、後学のためお教えいただければ
幸甚です。m(__)m

（隠居Z） 2023/02/20(月) 08:56:22

  CSVファイルは35行単位で1日のデータ
 データシートの日付が一致する行、IDが一致する列にデータを書き込みたい
 という理解でいいでしょうか

 マクロでやるとして、キモは、
 A列から該当の日付を探して、その行の該当のIDを探す
 該当箇所に、日付と24時間分（24行）のデータ（全25行）を貼り付ける
 ということになりそうです。

 多分、技術的に面倒なのは、日付の検索です
 過去ログを検索すると結構ヒットすると思います
（´・ω・`） 2023/02/20(月) 09:43:38

[[20220220095335]]
一年前のこれは解決したんですか。
（?） 2023/02/20(月) 11:07:38

 Sub Sample()
   Dim motoWs As Worksheet
   Dim sakiWs As Worksheet
   Dim myDate As Date
   Dim mRow As Long
   Dim mColumn As Long
   Dim sRow As Long
   '転記元、転記先シートを定義
   Set motoWs = Worksheets("CSV")
   Set sakiWs = Worksheets("データ")
   '転記先シートを2→37→72の順に35行ごとに巡回
   For sRow = 2 To sakiWs.Cells(Rows.Count, "B").End(xlUp).Row Step 35
    '転記元シートを1→36→71の順に35行ごとに巡回
    For mRow = 1 To motoWs.Cells(Rows.Count, "B").End(xlUp).Row Step 35
      '転記元シートの2列目から最終列まで巡回
      For mColumn = 2 To motoWs.Cells(mRow + 1, Columns.Count).End(xlToLeft).Column
        '転記先シートのIDセルの値と等しい場合
        If motoWs.Cells(mRow + 1, mColumn).Value = sakiWs.Cells(sRow, "B").Value Then
          With sakiWs.Cells(sRow + 3, Columns.Count).End(xlToLeft).Offset(, 1)
            '5行目に日付を入力
            .Value = motoWs.Cells(mRow, "B").Value
            '6～29行目行目に転記元シートの値を入力
            .Offset(1).Resize(24).Value = motoWs.Cells(mRow, mColumn).Offset(5).Resize(24).Value
            '列ループ脱出（同一IDが複数あっても2つ目以降を調べない）
            Exit For
          End With
        End If
      Next mColumn
    Next mRow
  Next sRow
 End Sub

仕様と合っているかどうかの自信がいまひとつありませんが
叩き台にはなるかもしれません。
（ふなば） 2023/02/20(月) 15:23:18

隠居Zさん

シート整形ツールを使用してみました。

     |[A]     |[B]          |[C]          |[D]          |[E]          |[F]          |[G]          
 [1] |タイトル|             |             |             |             |             |             
 [2] |ID　??  |100-AA-100000|100-AA-100001|100-AA-100002|100-AA-100003|100-AA-100004|100-AA-100005
 [3] |場所    |設置場所詳細 |設置場所詳細 |設置場所詳細 |設置場所詳細 |設置場所詳細 |設置場所詳細 
 [4] |単位    |単位         |単位         |単位         |単位         |単位         |単位         
 [5] |日付    |             |             |             |             |             |             
 [6] |1時00分 |             |             |             |             |             |             
 [7] |2時00分 |             |             |             |             |             |             
 [8] |3時00分 |             |             |             |             |             |             
 [9] |4時00分 |             |             |             |             |             |             
 [10]|5時00分 |             |             |             |             |             |             
 [11]|6時00分 |             |             |             |             |             |             
 [12]|7時00分 |             |             |             |             |             |             
 [13]|8時00分 |             |             |             |             |             |             
 [14]|9時00分 |             |             |             |             |             |             
 [15]|10時00分|             |             |             |             |             |             
 [16]|11時00分|             |             |             |             |             |             
 [17]|12時00分|             |             |             |             |             |             
 [18]|13時00分|             |             |             |             |             |             
 [19]|14時00分|             |             |             |             |             |             
 [20]|15時00分|             |             |             |             |             |             
 [21]|16時00分|             |             |             |             |             |             
 [22]|17時00分|             |             |             |             |             |             
 [23]|18時00分|             |             |             |             |             |             
 [24]|19時00分|             |             |             |             |             |             
 [25]|20時00分|             |             |             |             |             |             
 [26]|21時00分|             |             |             |             |             |             
 [27]|22時00分|             |             |             |             |             |             
 [28]|23時00分|             |             |             |             |             |             
 [29]|0時00分 |             |             |             |             |             |             
 [30]|日付    |             |             |             |             |             |             
 [31]|1時00分 |             |             |             |             |             |             
 [32]|2時00分 |             |             |             |             |             |             
 [33]|3時00分 |             |             |             |             |             |

A列33行以降は日付と時間の繰り返しです。
G列以降2～4行はID、場所、単位のみ入力してあります。
抽出したデータから同一IDの場所に日付と値を下段に貼り付けていきたいのです。

（´・ω・`）さんありがとうございます。検索頑張ってみます。

（?）さんご指摘ありがとうございます。解決後、閉じるのを忘れておりました。
あとでお礼とともに完了報告をしておきます。

ふなばさん、ありがとうございます。
試してみたのですが、下記のようになりました。
B5～AF5まで日付が入力され、その下に値が各33行まで貼り付けされましたが、
それ以降は空白のままでした。

     |[A]     |[B]          |[C]          |[D]          |[E]          |[F]          |[G]          
 [1] |タイトル|             |             |             |             |             |             
 [2] |ID　??  |100-AA-100000|100-AA-100001|100-AA-100002|100-AA-100003|100-AA-100004|100-AA-100005
 [3] |場所    |設置場所詳細 |設置場所詳細 |設置場所詳細 |設置場所詳細 |設置場所詳細 |設置場所詳細 
 [4] |単位    |単位         |単位         |単位         |単位         |単位         |単位         
 [5] |日付    |2022年8月1日 |2022年8月2日 |2022年8月3日 |2022年8月4日 |2022年8月5日 |2022年8月6日 
 [6] |1時00分 |           12|           12|           12|           12|           12|           12
 [7] |2時00分 |           12|           12|           12|           12|           12|           12
 [8] |3時00分 |           12|           12|           12|           12|           12|           11
 [9] |4時00分 |           12|           12|           11|           12|           12|           12
 [10]|5時00分 |           12|           12|           12|           12|           12|           12
 [11]|6時00分 |           11|           12|           12|           12|           12|           12
 [12]|7時00分 |           12|           12|           12|           11|           12|           12
 [13]|8時00分 |           12|           11|           12|           12|           12|           11
 [14]|9時00分 |           12|           12|           12|           12|           12|           12
 [15]|10時00分|           12|           12|           11|           12|           12|           12
 [16]|11時00分|           12|           12|           12|           12|           12|           11
 [17]|12時00分|           12|           12|           12|           12|           12|           12
 [18]|13時00分|           12|           12|           12|           12|           12|           11
 [19]|14時00分|           12|           12|           12|           12|           12|           12
 [20]|15時00分|           12|           12|           12|           12|           13|           12
 [21]|16時00分|           11|           12|           12|           12|           12|           11
 [22]|17時00分|           12|           12|           12|           11|           13|           12
 [23]|18時00分|           12|           12|           12|           12|           13|           12
 [24]|19時00分|           12|           12|           12|           12|           12|           11
 [25]|20時00分|           12|           12|           12|           12|           12|           12
 [26]|21時00分|           12|           11|           12|           12|           11|           12
 [27]|22時00分|           12|           12|           12|           12|           12|           11
 [28]|23時00分|           11|           12|           12|           12|           12|           12
 [29]|0時00分 |           12|           12|           11|           12|           12|           12
 [30]|日付    |             |             |             |             |             |             
 [31]|1時00分 |             |             |             |             |             |             
 [32]|2時00分 |             |             |             |             |             |             
 [33]|3時00分 |             |             |             |             |             |             
 [34]|4時00分 |             |             |             |             |             |             
 [35]|5時00分 |             |             |             |             |             |             
 [36]|6時00分 |             |             |             |             |             |             
 [37]|7時00分 |             |             |             |             |             |             
（悩み多き社畜） 2023/02/20(月) 21:33:42

抽出したデータにも整形ツールの使ってみました。

こんなデータが1データ35行で3万行ほど下につながっています。
A1のタイトル毎に日付順で1ヶ月分並んでいます。タイトルが変わるとまた1日からはじまる。
列は最大Q列（空白列があることも）まである場合があります。
1データ35行で日付がB1にしかありません。それ以降は+35の場所。

     |[A]         |[B]          |[C]          |[D]          |[E]          
 [1] |タイトル    |2022/8/1     |             |             |             
 [2] |            |100-AA-100000|100-AA-100001|100-AA-100002|100-AA-100003
 [3] |            |場所詳細     |場所詳細     |場所詳細     |場所詳細     
 [4] |            |単位         |単位         |単位         |単位         
 [5] |            |accumulator  |accumulator  |accumulator  |accumulator  
 [6] |1:00        |           30|          200|          100|            0
 [7] |2:00        |           30|          100|          100|            0
 [8] |3:00        |           40|          100|          100|            0
 [9] |4:00        |           30|          100|          100|            0
 [10]|5:00        |           30|          100|          100|            0
 [11]|6:00        |           40|          100|          110|            0
 [12]|7:00        |           30|          100|          100|            0
 [13]|8:00        |           40|          100|          100|            0
 [14]|9:00        |           50|          200|          100|            0
 [15]|10:00       |           40|          100|          100|            0
 [16]|11:00       |           50|          100|          100|            0
 [17]|12:00       |           40|          200|          100|            0
 [18]|13:00       |           40|          100|          100|            0
 [19]|14:00       |           50|          200|          110|            0
 [20]|15:00       |           40|          100|          100|            0
 [21]|16:00       |           50|          100|          100|            0
 [22]|17:00       |           40|          200|          100|            0
 [23]|18:00       |           40|          100|          100|            0
 [24]|19:00       |           40|          200|          100|            0
 [25]|20:00       |           40|          100|          100|            0
 [26]|21:00       |           40|          100|          100|            0
 [27]|22:00       |           50|          200|          100|            0
 [28]|23:00       |           50|          100|          100|            0
 [29]|24:00:00    |           40|          100|          100|            0
 [30]|不要なデータ|不要なデータ |不要なデータ |不要なデータ |不要なデータ 
 [31]|不要なデータ|不要なデータ |不要なデータ |不要なデータ |不要なデータ 
 [32]|不要なデータ|不要なデータ |不要なデータ |不要なデータ |不要なデータ 
 [33]|不要なデータ|不要なデータ |不要なデータ |不要なデータ |不要なデータ 
 [34]|不要なデータ|不要なデータ |不要なデータ |不要なデータ |不要なデータ 
 [35]|不要なデータ|不要なデータ |不要なデータ |不要なデータ |不要なデータ 
 [36]|タイトル    |2022/8/2     |             |             |             
 [37]|            |100-AA-100000|100-AA-100001|100-AA-100002|100-AA-100003
 [38]|            |場所詳細     |場所詳細     |場所詳細     |場所詳細     
 [39]|            |単位         |単位         |単位         |単位         
 [40]|            |accumulator  |accumulator  |accumulator  |accumulator  
 [41]|1:00        |           30|          100|          100|            0
 [42]|2:00        |           30|          200|          100|            0
 [43]|3:00        |           30|          100|          100|            0
 [44]|4:00        |           30|          100|          100|            0
 [45]|5:00        |           40|          100|          100|            0
（悩み多き社畜） 2023/02/20(月) 22:02:30

↑って　列は一ます一列、行は一ます35行として　下みたいな感じですか
1　～　17列[A～Q列まで]
■■■■■■■■■■■■■■■■■
■■■　■■■　■■
■■■　■■■　■■　■■■
■■■■　■■■　■
■■■■　■■■　■■　■■
■■■　■■■■■■
■■■■　■■■■■■■■　■■

　　↑　1

　　↓　33000

■■■　■■■■■■
■■■　■■■■■■　■■　■■■
■■■■■■■■■■■■■■■■■
■■■　■■■　■■　■■■
■■■■　■■■　■　　■■■■
■■■■　■■■　■■　■■
■■■　■■■■■■
＾＾；
m(__)m
（隠居Z） 2023/02/20(月) 23:15:37

隠居Zさん　

１マス？として考えるとそうなります。

A列は必ず入力があります。B列以降２行目にIDがあれば２～３５まで入力があります。
データを確認したところ最小D列でした。最大Q列。

私の方でも貼り付けに拘らずにINDIRECT等を使ってデータシート側から読み取れないかなとか、
色々と試行錯誤しているところです。

宜しくお願いします。
（悩み多き社畜） 2023/02/20(月) 23:38:04

おはよ～ございます。＾＾
あいぃ～。。。おまかせ～。。。と申し上げたいところですが。
何分、寄る年波と、炊事当番もあり。＾＾；かえって、ご迷惑を
お掛けする事態になりかねない為、バックグラウンドで挑戦とさせて
いただきます。←簡単に言うと
１．理解力が乏しいため、完成と言っても、使い物にならない場合もある
２．手が遅いので何時になるやら解らない。
３．一番恐ろしい所は、これくらいなら、多分出来ると思い込んでいる＾＾；
(◎_◎;)。。。m(__)m。で、
ダメもとで良ければ、作ってはみますが。。。当てにせず、お待ちくだ
さいと言う意味です。

という事で
引き続き、他の回答者様のお出ましを、お待ちくださいませ。済みません
m(__)mm(__)mm(__)m
（隠居Z） 2023/02/21(火) 09:03:33

どうやら私が 2023/02/20(月) 15:23:18 で想定したものとは違っていたようです。
作り変えてみますので少々お待ちください。

（ふなば） 2023/02/21(火) 12:02:18

 Sub Sample()
   Dim motoWs As Worksheet
   Dim sakiWs As Worksheet
   Dim IDRng As Range
   Dim sRng As Range
   Dim mRow As Long
   Dim mColumn As Long
   Dim sColumn As Variant
   '転記元、転記先シートを定義
   Set motoWs = Worksheets("CSV")
   Set sakiWs = Worksheets("データ")
   '転記先のIDが記入されている範囲を定義
   Set IDRng = sakiWs.Range("B2", sakiWs.Cells(2, Columns.Count).End(xlToLeft))
   '転記元シートを1→36→71の順に35行ごとに巡回
   For mRow = 1 To motoWs.Cells(Rows.Count, "B").End(xlUp).Row Step 35
     '転記元シートの2列目から最終列まで巡回
     For mColumn = 2 To motoWs.Cells(mRow + 1, Columns.Count).End(xlToLeft).Column
       '転記先シートのIDから等しい値を探す
       sColumn = Application.Match(motoWs.Cells(mRow + 1, mColumn).Value, IDRng, 0)
       '等しい値があった場合に転記
       If IsNumeric(sColumn) Then
         '転記先の先頭セルを設定
         Set sRng = IDRng(1, sColumn)
         If sRng.End(xlDown).Row < Rows.Count Then
           Set sRng = sRng.End(xlDown)
         End If
         With sRng
           '直下の空き行に日付を入力
           .Offset(1).Value = motoWs.Cells(mRow, "B").Value
           'さらにその下の24行に転記元シートの値を入力
           .Offset(2).Resize(24).Value = motoWs.Cells(mRow, mColumn).Offset(5).Resize(24).Value
         End With
       End If
     Next mColumn
   Next mRow
 End Sub

すでに転記先に転記用IDがある前提になっています（転記先の一覧にないIDは転記されません）。
2つ目の日付以降は下の行に追記されていきます。
（ふなば） 2023/02/21(火) 13:41:45

隠居Z様、わざわざありがとうございます。

ふなばさん、ありがとうございます！思っていたような振り分けが出来ました！

抽出したデータ側の不備で一部位置ずれしていますが、それはデータの方で位置修正します。
本当にありがとうございました
貴重なお時間でマクロを作成していただき感謝いたします。

これにてこの質問を終了とさせていただきます。

回答していただいた皆様、本当にありがとうございました。
（悩み多き社畜） 2023/02/23(木) 09:09:34

解決された様で何よりです。＾＾ｖ
質問を終了！承りました。お役に立てず恐縮です

m(__)m
（隠居Z） 2023/02/23(木) 09:18:20

お世話になります。

一度閉じておいて恐縮ですが、ふなばさんかもしくは分かる方がおりましたらお願いします。

上のマクロで同じ日で同じIDの場合、2回目は処理しないということは可能でしょうか。

CVSのデータ毎に各IDが設定されてるのですが、同じIDが別のデータにも登場することがあります。
データ内容は同じ日の同じIDなので数値はまったく同じなので2回目の処理はしないようにしたいのですが。

現状、動かすと同じ日に同じIDがある場合、2回目以降も下段に向けて同じ処理が繰り返されております。

     |[A]          |[B]          
 [1] |100-AA-100039|100-AA-100040
 [2] |場所詳細     |場所詳細     
 [3] |単位         |単位         
 [4] |2023年2月22日|2023年2月22日
 [5] |           20|            0
 [6] |           20|            0
 [7] |           20|            0
 [8] |           20|            0
 [9] |           20|            1
 [10]|           20|            0
 [11]|           20|            0
 [12]|           20|            0
 [13]|           20|            0
 [14]|           30|            1
 [15]|           20|            0
 [16]|           20|            1
 [17]|           30|            0
 [18]|           20|            1
 [19]|           20|            0
 [20]|           30|            1
 [21]|           20|            0
 [22]|           20|            0
 [23]|           30|            0
 [24]|           20|            0
 [25]|           20|            0
 [26]|           20|            1
 [27]|           20|            0
 [28]|           10|            0
 [29]|             |2023/2/22    
 [30]|             |            0
 [31]|             |            0
 [32]|             |            0
 [33]|             |            0
 [34]|             |            1
 [35]|             |            0
 [36]|             |            0
 [37]|             |            0
 [38]|             |            0
 [39]|             |            1
 [40]|             |            0
 [41]|             |            1
 [42]|             |            0
 [43]|             |            1
 [44]|             |            0
 [45]|             |            1
 [46]|             |            0
 [47]|             |            0
 [48]|             |            0
 [49]|             |            0
 [50]|             |            0
 [51]|             |            1
 [52]|             |            0
 [53]|             |            0
（悩み多き社畜） 2023/02/23(木) 14:01:54

 あまりよく分かってないですが、私なりに解釈しました
 役に立たなかったらすててください。
 Sub Sample()
   Dim wsTo As Worksheet, wsFrom As Worksheet
   Dim id As String, dd As Date, buf() As Variant
   Set wsFrom = Worksheets("CSV")
   Set wsTo = Worksheets("データ")
   For i = 1 To wsFrom.Cells(Rows.Count, "A").End(xlUp).Row Step 35
       dd = wsFrom.Cells(i, 2)
       For j = 2 To wsFrom.Cells(i, Columns.Count).End(xlToLeft).Column
           id = wsFrom.Cells(i + 1, j)
           buf() = wsFrom.Cells(i + 4, j).Resize(25).Value
           buf(1, 1) = dd
           On Error Resume Next
              getCell(wsTo, dd, id).Resize(25).Value = buf
           On Error GoTo 0
       Next
   Next
 End Sub

 Function getCell(ws As Worksheet, ByVal dd As Date, id As String) As Range
     Dim i As Long, j As Long
     i = WorksheetFunction.Match(CLng(dd), ws.Columns(1), 0)      ' 日付をコピー先シートの1列目から検索
     j = WorksheetFunction.Match(id, ws.Rows(2), 0)               ' IDをコピー先シートの2行目から検索
     Set getCell = ws.Cells(i, j)
 End Function
（´・ω・`） 2023/02/23(木) 16:57:48

（´・ω・`）さんありがとうございます。

マクロ試してみたのですが、そのままだと動きませんでした。
下記部分を修正したら動いたのですが、
日付の取得と転記をどうにかすればいいのでしょうが私には分かりませんでした。

Function getCell欄のi=～ws.Columns(1), 0)部分をws.Columns(5), 0)に変更。

コピー先のシートには最初日付が入っておりませんので
コピー元から取得して5行目に転記する必要があります。（それ以降は1＋24の場所30、55、80…

コピー先の配置

     |[A]     |[B]          |[C]          |[D]          |[E]          |[F]          |[G]          
 [1] |タイトル|             |             |             |             |             |             
 [2] |ID　    |100-AA-100000|100-AA-100001|100-AA-100002|100-AA-100003|100-AA-100004|100-AA-100005
 [3] |場所    |設置場所詳細 |設置場所詳細 |設置場所詳細 |設置場所詳細 |設置場所詳細 |設置場所詳細 
 [4] |単位    |単位         |単位         |単位         |単位         |単位         |単位         
 [5] |日付    |             |             |             |             |             |             
 [6] |1時00分 |             |             |             |             |             |             
 [7] |2時00分 |             |             |             |             |             |             
 [8] |3時00分 |             |             |             |             |             |             
 [9] |4時00分 |             |             |             |             |             |             
 [10]|5時00分 |             |             |             |             |             |             
 [11]|6時00分 |             |             |             |             |             |             
 [12]|7時00分 |             |             |             |             |             |             
 [13]|8時00分 |             |             |             |             |             |             
 [14]|9時00分 |             |             |             |             |             |             
 [15]|10時00分|             |             |             |             |             |             
 [16]|11時00分|             |             |             |             |             |             
 [17]|12時00分|             |             |             |             |             |             
 [18]|13時00分|             |             |             |             |             |             
 [19]|14時00分|             |             |             |             |             |             
 [20]|15時00分|             |             |             |             |             |             
 [21]|16時00分|             |             |             |             |             |             
 [22]|17時00分|             |             |             |             |             |             
 [23]|18時00分|             |             |             |             |             |             
 [24]|19時00分|             |             |             |             |             |             
 [25]|20時00分|             |             |             |             |             |             
 [26]|21時00分|             |             |             |             |             |             
 [27]|22時00分|             |             |             |             |             |             
 [28]|23時00分|             |             |             |             |             |             
 [29]|0時00分 |             |             |             |             |             |             
 [30]|日付    |             |             |             |             |             |             
 [31]|1時00分 |             |             |             |             |             |             
 [32]|2時00分 |             |             |             |             |             |             
 [33]|3時00分 |             |             |             |             |             |  
以降、日付と時間の繰り返し。

（悩み多き社畜） 2023/02/23(木) 19:44:34

 A5やA30は日付が入っているのではないのですか？
 そうだとおもったので、A列で日付を検索するようにしました。

 >ws.Columns(5)
 なんで5列目（E列）なのか全然わかりません

 元のシートの日付は、
  dd = wsFrom.Cells(i, 2)
 で取得してます
  buf() = wsFrom.Cells(i + 4, j).Resize(25).Value ' データの1行上からデータ数+1行分を配列に取得
  buf(1, 1) = d   ' 配列の最初の要素に日付を代入
 とすることで、データと一緒に貼り付けています。
　         
 私のマクロは捨ててください
（´・ω・`） 2023/02/23(木) 20:33:13

こんばんわ。＾＾
解決された様で。。。もう、ご覧になっていないかもですが。
合っているかどうかも、良くわかりません。＾＾；
研究発表のつもりで、アップさせて戴きました。何とか、でき
たよ～な気がします。(￣▽￣)。。。←気がするだけなので
お役に立たない場合はポイしてくださいね。でわでわm(__)m
処理速度はいまいちな感じで、課題が残るかもです。

 Option Explicit
Sub OneInstanceMain()
    Dim t             As Double
    Dim rr            As Range
    Dim v()           As Variant
    Dim w()           As Variant
    t = Timer
    With Worksheets("データ")
        .Activate
        .UsedRange.Clear
        .Range("D10") = "只今処理中。。。暫くお待ちください。"
    End With
    dAtaGet rr, v
    iNportData w, v
    zDLookUp w()
    Erase v, w
    MsgBox "終了" & Format(Int(Timer - t) / 24 / 60 / 60, "hh : mm : ss") & _
                      Format((Timer - t) - Int(Timer - t), ".000") & " 秒"
End Sub
Private Sub iNportData(w(), v())
    Dim var           As Variant
    Dim i             As Long
    Dim j             As Long
    Dim k             As Long
    Dim n             As Long
    Dim y             As Long
    Dim a             As Long
    Dim hD            As Double
    Dim iDx()         As Variant
    Dim w2()          As Variant
    For i = 1 To UBound(v, 1) Step 35
        hD = v(i, 2)
        For j = 2 To UBound(v, 2)
            If v(i + 1, j) <> "" Then
                ReDim w(1 To 36, 1 To 1)
                w(1, 1) = Format(hD, "yyyy/mm/dd")
                w(2, 1) = v(i, 1)
                y = 3
                n = i + 1
                For k = n To n + 33
                    w(y, 1) = v(k, j)
                    y = y + 1
                Next
                ReDim Preserve iDx(a)
                iDx(a) = w
                a = a + 1
            End If
       Next
       If i Mod 128 = 0 Then DoEvents
   Next
   ReDim w(1 To UBound(iDx) + 1, 1 To 36)
   For i = LBound(iDx) To UBound(iDx)
       For j = 1 To UBound(iDx(i))
           w(i + 1, j) = iDx(i)(j, 1)
       Next
   Next
   w2() = Application.Sort(w, 1, 1, False)
   Erase w
   w = w2
   Erase iDx, w2
End Sub
Private Sub dAtaGet(ByVal r As Range, aRy())
    With Worksheets("1")
        Set r = Intersect(.UsedRange, .Range("A:Q"))
        aRy = r.Value
    End With
End Sub
Private Sub zDLookUp(w())
    Dim i             As Long
    Dim iMax          As Long
    Dim j             As Long
    Dim y             As Long
    Dim a             As Long
    Dim c             As Long
    Dim n             As Long
    Dim x             As Variant
    Dim v()           As Variant
    Dim iDk()         As Variant
    Dim iKey()        As Variant
    Dim dKey()        As Variant
    Dim tAry(1 To 25) As Variant
    Dim zId           As Object
    Dim zTdata        As Object
    Dim zD            As Object
    Dim ans           As Object
    Dim var           As Variant
    Set zId = CreateObject("Scripting.Dictionary")
    Set zTdata = CreateObject("Scripting.Dictionary")
    Set zD = CreateObject("Scripting.Dictionary")
    zId(0) = Array("PLACE", "UNIT")
    For i = 1 To UBound(w, 1)
        zId(w(i, 3)) = Array(w(i, 4), w(i, 5))
        zD(w(i, 3)) = zD(w(i, 3)) + 1
        ReDim v(1 To UBound(w, 2))
        For j = 1 To UBound(w, 2)
            v(j) = w(i, j)
        Next
        zTdata(w(i, 3) & Chr(32) & w(i, 1)) = v
    Next
    iMax = Application.Max(zD.items)
    iKey = Application.Sort(zId.keys, 1, 1, True)
    ReDim v(1 To iMax * 25, 1 To UBound(iKey))
    dKey = zTdata.keys
    tAry(1) = "日付"
    For i = 2 To 25
        tAry(i) = i - 1 & ":00"
    Next
    y = 0
    For i = 0 To UBound(dKey)
        x = False
        For j = 1 To UBound(iKey)
            If iKey(j) = zTdata(dKey(i))(3) Then
                x = j
                Exit For
            End If
        Next
        yGetFromArray v, y, x
        If Not IsError(x) Then
            c = 8
            For n = 1 To 25
                y = y + 1
                If v(y, 1) = "" Then
                    v(y, 1) = tAry(n)
                End If
                Select Case n
                    Case 1
                        v(y, x) = zTdata(dKey(i))(1)
                    Case 2
                        v(y, x) = zTdata(dKey(i))(7)
                    Case 3 To 25
                        v(y, x) = zTdata(dKey(i))(c)
                        c = c + 1
                End Select
            Next
        End If
        If i Mod 1280 = 0 Then DoEvents
    Next
    With Worksheets("データ")
        .Cells(2, 1).Resize(, UBound(iKey)) = iKey
        .Cells(3, 1).Resize(2, UBound(zId.items) + 1) = Application.Transpose(zId.items)
        .Cells(5, 1).Resize(UBound(v, 1), UBound(v, 2)) = v
        .[A1] = "タイトル"
        .[A2] = "ID"
        Intersect(.UsedRange, .Range("A:A")).NumberFormatLocal = "[h]:mm"
        .UsedRange.Columns.AutoFit
    End With
    zId.RemoveAll
    zTdata.RemoveAll
    zD.RemoveAll
    Erase v, iDk, iKey, dKey, tAry
End Sub
Private Sub yGetFromArray(v(), y As Long, ByVal x As Long)
    Dim i As Long
        For i = 1 To UBound(v, 1)
            If v(i, x) = "" Then
                y = i - 1
                Exit For
            End If
            If i Mod 1280 = 0 Then DoEvents
        Next
End Sub
（隠居Z） 2023/02/25(土) 23:08:15

.Range("D10") = "只今処理中。。。暫くお待ちください。"
の初期化をわすれています。といいますか、その、どうせ上書きされるので
良いかとと思っていましたが、処理対象情報が極端に少ない場合、メッセー
ジが残る可能も無いとは言えないので、念を入れてと言いますか、＾＾；
手を抜かずに処理すべきでした、良きにお計いを、お願いいたします。
お試の際はバックアップ、必須です。←ｗ、どなたも試さないかもあははは。(￣▽￣；)
でわでわ。↑もっと大事な箇所、ミスってるかもw(◎。×)w。ガ～ン
m(__)mm(__)mm(__)m
（隠居Z） 2023/02/26(日) 10:08:07

コメント返信：

[ 一覧(最新更新順) ]

[[20230220030902]] 『各IDを日付順に他シートに振り分けて転記したい。』（悩み多き社畜） ページの最後に飛ぶ

[[20230220030902]]　『各IDを日付順に他シートに振り分けて転記したい。』（悩み多き社畜）　ページの最後に飛ぶ