Results of 1 - 1 of about 19648 for 20�����������������������... (0.004 sec.)
- [[20230220030902]]
- #score: 2682
- @digest: 3510c6900d8bd1a0e7bb33beb02fecb7
- @id: 93562
- @mdate: 2023-02-26T01:08:07Z
- @size: 36555
- @type: text/plain
- #keywords: 時00 (214666), 所詳 (185209), 分| (172078), 細| (128995), 要| (127154), 要不 (110139), タ| (83074), 位| (82888), accumulator (73808), mcolumn (72681), motows (70685), 置場 (66492), 白不 (60967), 白0 (52903), 要空 (51665), ztdata (50119), sakiws (44981), ■■■ (37320), wsfrom (34768), 各id (32237), 社畜 (32011), 白10 (31223), 不要 (26452), 設置 (16669), mrow (14998), 所| (13582), ■■ (10867), 単位 (10740), 付| (9562), 場所 (8812), 詳細 (8702), 記元 (7368)
- 『各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の下に日付と値を貼り付けていきたい。 は 一つのセルに日付と、値を貼り付けるのですか??;w ←おぉ要らぬお世話でした 私がご案内差し上げるという意味では御座いません。が。。。(◎_◎;) すこぉおし興味が御座いまして、差支えなければ、後学のためお教えいただければ 幸甚です。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さん 1マス?として考えるとそうなります。 A列は必ず入力があります。B列以降2行目にIDがあれば2〜35まで入力があります。 データを確認したところ最小D列でした。最大Q列。 私の方でも貼り付けに拘らずにINDIRECT等を使ってデータシート側から読み取れないかなとか、 色々と試行錯誤しているところです。 宜しくお願いします。 （悩み多き社畜） 2023/02/20(月) 23:38:04 ---- おはよ〜ございます。^^ あいぃ〜。。。おまかせ〜。。。と申し上げたいところですが。 何分、寄る年波と、炊事当番もあり。^^;かえって、ご迷惑を お掛けする事態になりかねない為、バックグラウンドで挑戦とさせて いただきます。←簡単に言うと 1.理解力が乏しいため、完成と言っても、使い物にならない場合もある 2.手が遅いので何時になるやら解らない。 3.一番恐ろしい所は、これくらいなら、多分出来ると思い込んでいる^^; (◎_◎;)。。。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 ---- 解決された様で何よりです。^^v 質問を終了!承りました。お役に立てず恐縮です 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(◎。×)w。ガ〜ン m(__)mm(__)mm(__)m （隠居Z） 2023/02/26(日) 10:08:07... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/202302/20230220030902.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97023 documents and 608156 words.
訪問者：