[[20201024153857]]　『合計した数分だけ色付けしたいです。』（まつ）　ページの最後に飛ぶ

『合計した数分だけ色付けしたいです。』（まつ）

エクセルで

 シートを２つ使います。
 シート1では数字の記号があり(種類多い)
 AさんBさんそれぞれ
 個数を記号ごとに手入力するシートです。 シート2では
 順番バラバラに記号が
 縦方向に並んだ一覧のあるシートです。
 したいことは
 2のシートで
 記号の一致するセルを
 それぞれの個数分だけ
 AさんとBさんが被らないように
 色分けしていきたいです。
 (例)シート1
     |  A   |  B
 12  |  1   |  3
 16  |  7   |  0
 11  |  1   |   2 
 •
 •
 •
         ↑      ↑数字手入力
 (例)シート2
 記号
 12←Aさんの色
 12←Bさんの色
 19
 16
 12←Bさん
 11
 16
 14
 12←Bさん
 12←色付けなし
 13
 •
 •
 •
 ↑手入力した分色付け

 補足
 シート1は毎日使い回すので
 個数記入の欄は
 １日の終わりに0に戻します。
 2は色付けしたまま残したいです。

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

コメントがつかないですね。
何か動作が不自然というか、作業の意図がわかりにくいです。
なにか質問するにあたって、必要なことが漏れているのではと懸念されます。
　
確認ですけど、
1．シート2というのは、誰が入力したのですか？
　Aさん、Bさんとの関係はどうなっているのですか？
　入力者が誰かとかの列があって、その個数を確認したい、
　とか言ったことではないんですか？
　
2．それぞれの記号について、
　上からAさんに指定された個数を塗りつぶし、
　それが終わったら、次にBさんの分だけ塗りつぶす
　ということで良いのですか？
　
3．それなら、最初からソートなりしておくとかもOKなんですか？
　シート1の情報をもとに、記号列を生成したほうが早くないですか？
　
もう少し、実感がわくような背景説明があったほうが、
回答者も取り組む意欲が湧くと思いますよ。
（γ） 2020/10/24(土) 20:49

1.シート2は発注が来てからの生産順番です。
　AさんとBさんは同じ作業をする人ですが
　時間差があるので色分けしたいと思ってます。
　入力はそれぞれAさんBさんでシート2での
　消し込みと漏れがないかの確認目的です。

2.その通りです。

3.シート2は発注書の貼り付け場所なので
　ソートOKです。　
　記号列は新しいシートを増やすとかでならOKです。

（まつ） 2020/10/25(日) 12:10

 >　時間差があるので色分けしたいと思ってます。
 これは少し納得する要素でした。

 >  　入力はそれぞれAさんBさんでシート2での
 >  　消し込みと漏れがないかの確認目的です。
 入力者を入れる列などはないんですか？普通はそうしません？
 そうすれば、あとはシート2で個数だけを再集計して比較するだけだと思いますが。

 もしそういう入力者判別情報があれば、
 下記のようなマクロでA,Bそれぞれ別の色を付けると、
 それぞれが一致しないことになりますよ。

 まあ、一応、コードを書いてみたので、参考にして下さい。

 Sub test()
     Dim ws1 As Worksheet, ws2 As Worksheet
     Dim dicAmax As Object
     Dim dicBmax As Object
     Dim dicA As Object
     Dim dicB As Object
     Dim k As Long
     Dim r As Range
     Dim v As Variant

     Set dicAmax = CreateObject("Scripting.Dictionary")
     Set dicBmax = CreateObject("Scripting.Dictionary")
     Set dicA = CreateObject("Scripting.Dictionary")
     Set dicB = CreateObject("Scripting.Dictionary")
     Set ws1 = Worksheets("Sheet1")
     Set ws2 = Worksheets("Sheet2")

     '個数を取り込む
     For k = 2 To ws1.Cells(Rows.Count, "A").End(xlUp).Row
         dicAmax(ws1.Cells(k, 1).Value) = ws1.Cells(k, 2).Value
         dicBmax(ws1.Cells(k, 1).Value) = ws1.Cells(k, 3).Value
     Next

     '上から順に処理（枠内であれば着色。完了済み個数をカウントアップ）
     For k = 1 To ws2.Cells(Rows.Count, "A").End(xlUp).Row
         Set r = ws2.Cells(k, 1)
         v = r.Value
         If dicA(v) < dicAmax(v) Then
             r.Interior.Color = vbRed    '色は適当に修正
             dicA(v) = dicA(v) + 1
         ElseIf dicB(v) < dicBmax(v) Then
             r.Interior.Color = vbYellow '色は適当に修正
             dicB(v) = dicB(v) + 1
         End If
     Next
 End Sub

（γ） 2020/10/25(日) 12:26

シート1ではAさんとBさん入力欄を分けて
シート2では色分けが入力者判別情報と
考えてたので
入力者を入れる列は考えてなかったです。

コードありがとうございます。
入力してみましたが再生しても
何も起きなかったです。

シート1でBC列に手入力とか
シート2のABC列に反映させたい
とかの情報不足でしょうか？
（まつ） 2020/10/25(日) 16:19

提示したコードは、
Sheet1のA列に記号、B列にAさんの個数、C列にBさんの個数があるものとし、
Sheet2のA列にある記号のセルに色分けをしています。
それに合っていなければ、あなたのほうで調整してください。

（γ） 2020/10/25(日) 16:39

＞シート2のABC列に反映させたい

意味不明です。
B,C列に履歴を残す運用ではだめですか。

 Option Explicit

 Sub test()
     Dim dic As Object
     Dim r As Range, c As Range
     Dim k As Long, i As Long
     Dim 記号

     Set dic = CreateObject("Scripting.Dictionary")

     Set r = Worksheets("Sheet1").Cells(1).CurrentRegion

     For Each c In Intersect(r.Columns(1), r.Offset(1))
        記号 = c.Value
        If Not dic.exists(記号) Then
            Set dic(記号) = CreateObject("system.collections.queue")
        End If
        For i = 1 To c.Offset(, 1).Value
            dic(記号).enqueue "A"
        Next
        For i = 1 To c.Offset(, 2).Value
            dic(記号).enqueue "B"
        Next
    Next

    Set r = Worksheets("Sheet2").Cells(1).CurrentRegion

    For Each c In r.Columns(2).SpecialCells(xlCellTypeBlanks)
        記号 = c.Offset(, -1).Value
        If dic.exists(記号) Then
            If dic(記号).Count > 0 Then
                c.Value = dic(記号).dequeue
                c.Offset(, 1).Value = Now
            End If
        End If
    Next

 End Sub

（マナ） 2020/10/25(日) 17:52

マクロを実行したら、シート１をリセットしないとまずいです。

（マナ） 2020/10/25(日) 17:56

念のため申し上げるが、
私は特に未確認だと断らない限り、
実行して動作確認したものしか提示することはありません。
そのように考えて回答を今までしてきました。

このコードももちろん確認済みのものです。
気安く「何も起きない」などと言われたくない。
あなたが内容をまったく理解していないからだと思う。

（γ） 2020/10/25(日) 22:48

コメント返信：

[ 一覧(最新更新順) ]

[[20201024153857]] 『合計した数分だけ色付けしたいです。』（まつ） ページの最後に飛ぶ

[[20201024153857]]　『合計した数分だけ色付けしたいです。』（まつ）　ページの最後に飛ぶ