エクセルに詳しい方、お願いします。

　　例を挙げます。　
　添付図のように、1月から12月までの各月の数字に合わせて、〔ふた〕の数だけセルを塗りつぶしたいのです。または〔■〕印を黒以外で書き込みたいのです。

〔ふた〕〔胴体〕〔脚〕を組み合わせて、一個の製品にした場合の半端物をできるだけ少なくしたいのです。

塗りつぶす数は、最大（３６６×２＝）７３２セルです。
塗りつぶした月が区別できるように、各月の塗りつぶした部分を色やパターンで月ごとに区別できると、尚良いのです。2色で交互でも良いのです。

実際には、農薬や肥料・パッケージのパーツ数などの在庫と注文などの管理に応用したいのです。
集計表で、計算すれば良いのですが、視覚的にさっと累計を把握したいのです。

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

No.3 ベストアンサー 回答者： tom04 回答日時： 2014/11/07 19:20

こんばんは！

すでに解決済みのようなので余計なお世話かもしれませんが・・・

VBAになってしまいますけど、↓の画像のような感じでやってみました。
上側のSheet1の2行目に塗りつぶしたい色にしておきます。
そしてSheet2のA列にSheet1のA列と同じデータを入力しておきます。（数はいくつでも大丈夫です）
尚、Sheet2の1行目はトータルでいくつになるか？の数値を表示させるようにしていますので、
Sheet2は2行目以降を使用してください。

Alt＋F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面のカーソルが点滅しているところに
↓のコードをコピー＆ペースト　→　Excel画面に戻りマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub Sample1() 'この行から
Dim i As Long, j As Long, lastRow As Long, lastCol As Long
Dim myMax As Long, c As Range, wS As Worksheet
Set wS = Worksheets("Sheet1")
Application.ScreenUpdating = False
With Worksheets("Sheet2")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
lastCol = .UsedRange.Columns.Count
If lastCol > 1 Then
.Rows(1).ClearContents
With Range(.Cells(2, "B"), .Cells(lastRow, lastCol))
.Font.ColorIndex = xlAutomatic
.Interior.ColorIndex = xlNone
.ClearContents
End With
End If
For i = 3 To wS.Cells(Rows.Count, "A").End(xlUp).Row
Set c = .Range("A:A").Find(what:=wS.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
For j = 2 To wS.Cells(i, Columns.Count).End(xlToLeft).Column
If wS.Cells(i, j) > 0 Then
With .Cells(c.Row, Columns.Count).End(xlToLeft).Offset(, 1).Resize(, wS.Cells(i, j))
.Value = 1
.Font.Color = wS.Cells(2, j).Interior.Color
.Interior.Color = wS.Cells(2, j).Interior.Color
End With
End If
Next j
myMax = WorksheetFunction.Max(myMax, .Cells(c.Row, Columns.Count).End(xlToLeft).Column)
Next i
For j = 2 To myMax
.Cells(1, j) = j - 1
Next j
End With
Application.ScreenUpdating = True
End Sub 'この行まで

※　関数でないのでSheet1のデータ変更があるたびに
マクロを実行する必要があります。m(_ _)m

この回答への補足

ありがとうございます。
三晩目にしてマクロが動き、所期の目標を完璧にクリアしました。

＞（数はいくつでも大丈夫です）
＞Sheet2の1行目はトータルでいくつになるか？の数値を表示させる…

瞬時に表示されるので、何度試行しても飽きません。　(*^_^*)/

　マクロ初挑戦ですので下記のことが、私にはできません。
◇【Sheet１】と【Sheet２】で、それぞれ【一行目】と【一列目】に別の文言等を入れても働くマクロ。つまり、１セルずつ右下に移動したいのです。
◇　更に、【Sheet２】の塗りつぶした｛全ての｝セルに【Sheet１】の項目｛今回は月でした。｝を表示するようなマクロを書いてくださいませんか？

今回いただいた記述と較べて、マクロの動きに手を加えたく思い、お願いいたします。。
　　　　　　　　　　　　　　　　　　　　　　　　　　　　m(_ _)m　　


　　　

補足日時：2014/11/10 01:24

この回答へのお礼

マクロ記述を比較して、マクロを翻訳〔？〕する面白さを見つけました。
今一度、教えてください。
http://okwave.jp/qa/q8822141.html

お礼日時：2014/11/12 02:36

No.4 回答者： tom04 回答日時： 2014/11/11 13:52

No.3です。

補足の件について・・・

↓の画像のような配置でよろしいのでしょうか？
そして、Sheet2の塗りつぶされているセルには
Sheet1の2行目「項目」データにしています。
（フォント色が同じなので、セルを選択し数式バーを見てもらえばそのセルのデータが判ると思います）

Sub Sample2()
Dim i As Long, j As Long, lastRow As Long, lastCol As Long
Dim myMax As Long, c As Range, wS As Worksheet
Set wS = Worksheets("Sheet1")
Application.ScreenUpdating = False
With Worksheets("Sheet2")
lastRow = .Cells(Rows.Count, "B").End(xlUp).Row 'B列最終行取得★
lastCol = .UsedRange.Columns.Count '最終列取得☆
If lastRow > 1 Then
With Range(.Cells(2, "C"), .Cells(lastRow, lastCol))
.Font.ColorIndex = xlAutomatic
.Interior.ColorIndex = xlNone
.ClearContents
End With
End If
For i = 4 To wS.Cells(Rows.Count, "B").End(xlUp).Row '4行目からSheet1B列最終行まで★
Set c = .Range("B:B").Find(what:=wS.Cells(i, "B"), LookIn:=xlValues, lookat:=xlWhole) '★
For j = 3 To wS.Cells(i, Columns.Count).End(xlToLeft).Column '3（C列）～Sheet1のi行最終列まで★
If wS.Cells(i, j) > 0 Then
With .Cells(c.Row, Columns.Count).End(xlToLeft).Offset(, 1).Resize(, wS.Cells(i, j))
.Value = wS.Cells(2, j) 'Sheet1の2行目j列データを表示★
.Font.Color = wS.Cells(3, j).Interior.Color '文字色=Sheet1の3行目j列の色★
.Interior.Color = wS.Cells(3, j).Interior.Color '塗りつぶし=Sheet1の3行目j列の色★
End With
End If
Next j
'▼一番データ量が多い列数を取得
myMax = WorksheetFunction.Max(myMax, .Cells(c.Row, Columns.Count).End(xlToLeft).Column)
Next i
For j = 3 To myMax '3列目～最大列数まで
.Cells(2, j) = j - 2 '2行目に数量表示★
Next j
End With
Application.ScreenUpdating = True
End Sub

こんなんではどうでしょうか？
※　今回は若干のコード説明（前回の変更分等）を入れてみました。m(_ _)m

この回答への補足

詳しく、書き込んで頂きました。
マクロにおもしろさを見つけました。　　　　　　(*^_^*)/
感謝いたします。ありがとうございます。



http://okwave.jp/qa/q8822141.html
今一度あらためて、お教えくださるようにお願い申し上げます。
添付図の下段ように横積みグラフで色分けされたセルに
【1月】～【〇月】までの文字を書き入れるマクロを教えてください。

また、Tom04様のように【A1】セルに【行＼列】を打ち込んだときに絶妙に〔行〕を〔列〕より低く、〔列〕を〔行〕より高く表示する術を教えてください。

補足日時：2014/11/12 02:30

この回答へのお礼

感謝しています。
この欄のお礼を漏らしました。　m(_ _)m

お礼日時：2015/01/25 21:52

No.2 回答者： keithin 回答日時： 2014/11/06 23:45

＞視覚的にさっと累計を把握したいのです

エクセルではそういう目的のために、「グラフ」という機能を利用することが出来ます。
ご相談で作成したいのは、グラフの種類の中から「横棒積み上げグラフ」というモノを利用します。

参考にしてください：
http://excel.ohugi.com/091005.htm

実際にやってみると判りますが、長々と■を連ねたり、延々とセルの塗色を積み重ねたりといった融通の利かないやり方は苦労ばかり多くてあまり見た目もよくありません。

この回答への補足

問題なく、できました。
重ねてお礼申し上げます。

補足日時：2014/11/07 05:46

この回答へのお礼

早速のご回答ありがとうございます。
実際に、作成されたことに感謝致します。
「横棒積み上げグラフ」は、素晴らしいと思います。

グラフにはしばらく触れていなかったので、私の実務で応用できるか試行します。

お礼日時：2014/11/07 05:41

No.1 回答者： mike_g 回答日時： 2014/11/06 20:08

》 添付図のように…

何処に？