[[20191101001918]]　『シートにある名前を複数の条件で別シートの指定の』（ぷーさん）　ページの最後に飛ぶ

『シートにある名前を複数の条件で別シートの指定のセルに編集したい』（ぷーさん）

はじめて投稿致します。
現在仕事で以下のようなシートがあるブックの編集をする必要があり、
関数では無理と判断したものの、エクセルVBAが使いこなせる状況では
ありません。実現したいことを、拙い説明ですが以下にまとめました。
ご教授頂ければと、藁をもすがる思いで投稿しました。

＊やりたいこと＊
2019/10/1(シリアル値でやってくる)から始まる、担当ごとのシフト表
シート名「シフト」から、日曜始まりの週間表　シート名「割り振り表」
へ、●職を対象に、同じ日付同じシフトのアルファベットの位置に担当名
をもってくることは関数では難しいと思うのですが、VBAであれば可能で
しょうか？可能なら、その手順・方法が知りたいと思っています。

シート名：シフト
職種　名前　　日付
　　　　　　　43739　　43740　　43741　43742　43743　　　
●職　田中　　　A 　　 B 　　　✖　　　J　　　D
●職　山田　　　F　　　 C　　　　C　　　F　　　✖
●職　川村　　　C　　　　D　　　 C　　　✖　　 A
〇職
〇職
　…

↓●職のシフトのみ、下記シートに編集したいのです。
↓

シート名：割り振り表

    9/29(日)  9/30(月)  10/1(火) 10/2(水) 10/3(木) 10/4(金) 10/5(土)
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
A　｜　　　　　　　　　　田中　　　　　　　　　　　　　　　　　　
B　｜　　　　　　　　　　　　　　田中　　　
C　｜　　　　　　　　　　川村　　山田　　　山田，川村
D　｜　　　　　　　　　　　　　　川村
F　｜　　　　　　　　　　山田
J　｜

↑この場合、10月のシフトが対象なので9月の2日分は空欄でOKです。
同じシフトが複数あった場合、可能なら名前を繋げたいです。
毎月1日の曜日は異なりますが、割り振り表は常に前月最後または当月
最初の日曜から始まるシートで、日付は一度に変換する設定にしてある
ので、都度手動で日付を更新します。

宜しくお願い致します。

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

割り振り表の日付もシリアル値ですか？
あと、同じ日で同じアルファベットになるのは最大何人ですか？
（黄色い循環参照） 2019/11/01(金) 01:29

早速の返信ありがとうございます。
割り振り表は曜日まで表示される定義に設定されています。
※テキストにおとすと日付は実はシリアルで、エクセルが見た目を変えてくれてるだけと
思ってました。日付を比較する際に変換が必要ですかね？

アルファベットはシフトのタイプを表してますが、最終的には同じアルファベット（シフト）
でも、フロア毎で別セルに移す予定です。シフト表上は同じアルファベットで表示
されてしまうのと、何人同じシフトに配置されるかは状況によるためです。
通常シフトCやDなどは2～3同じ職員を配置するようですが、行事などで一時的に
もっと同シフトを増やすことはあり得ます。が、イレギュラーはある程度想定して
手動で対応しようと思っています。同シフトのセルの配置のマックスが流動的なため、
繋げると言う発想になっています。同シフトの人をどのフロアに配置するかの情報は
シフトシートにはないから、と言う理由もあります。いずれにせよ、完璧な自動化は
無理なので、ある程度は目視編集前提の編集支援ツールとの位置付けです。
こんな状況なので、配置するシフトはアルファベットではなく、同じ日付列の
固定の行数のセルへ…と言う条件にすべきか？とも想像し、煮詰まってます。
運用側に無理ない範囲で運用条件の提示は可能です。
長くなり申し訳ありません。回答になっていれば幸いです。

（ぷーさん） 2019/11/01(金) 07:35

Sub main()

    Dim dic As Object, c As Range, cc As Range
    Set dic = CreateObject("Scripting.dictionary")
    For Each c In Intersect(Sheets("シフト").UsedRange, Sheets("シフト").Range("A:A"))
        If c.Value = "●職" Then
            For Each cc In Intersect(Sheets("シフト").UsedRange, c.EntireRow)
                If cc.EntireColumn.Cells(2) <> "" Then
                    dic(Format(cc.EntireColumn.Cells(2), "m/d(aaa)") & cc.Value) = cc.EntireRow.Cells(2)
                End If
            Next cc
        End If
    Next c
    For Each c In Intersect(Sheets("割り振り表").UsedRange, Sheets("割り振り表").Cells.SpecialCells(4))
        c.Value = dic(c.EntireColumn.Cells(1).Text & c.EntireRow.Cells(1).Value)
    Next c
End Sub
（mm） 2019/11/01(金) 11:20

mm様、コードありがとうございました。
頂いたコードを元に試行錯誤してみます。
すぐの回答ありがとうございました。

（ぷーさん） 2019/11/02(土) 10:06

コメント返信：

[ 一覧(最新更新順) ]

[[20191101001918]] 『シートにある名前を複数の条件で別シートの指定の』（ぷーさん） ページの最後に飛ぶ

[[20191101001918]]　『シートにある名前を複数の条件で別シートの指定の』（ぷーさん）　ページの最後に飛ぶ