
例を挙げます。
添付図のように、1月から12月までの各月の数字に合わせて、〔ふた〕の数だけセルを塗りつぶしたいのです。または〔■〕印を黒以外で書き込みたいのです。
〔ふた〕〔胴体〕〔脚〕を組み合わせて、一個の製品にした場合の半端物をできるだけ少なくしたいのです。
塗りつぶす数は、最大(366×2=)732セルです。
塗りつぶした月が区別できるように、各月の塗りつぶした部分を色やパターンで月ごとに区別できると、尚良いのです。2色で交互でも良いのです。
実際には、農薬や肥料・パッケージのパーツ数などの在庫と注文などの管理に応用したいのです。
集計表で、計算すれば良いのですが、視覚的にさっと累計を把握したいのです。
よろしくお願いいたします。

No.3ベストアンサー
- 回答日時:
こんばんは!
すでに解決済みのようなので余計なお世話かもしれませんが・・・
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行目はトータルでいくつになるか?の数値を表示させる…
瞬時に表示されるので、何度試行しても飽きません。 (*^_^*)/
マクロ初挑戦ですので下記のことが、私にはできません。
◇【Sheet1】と【Sheet2】で、それぞれ【一行目】と【一列目】に別の文言等を入れても働くマクロ。つまり、1セルずつ右下に移動したいのです。
◇ 更に、【Sheet2】の塗りつぶした{全ての}セルに【Sheet1】の項目{今回は月でした。}を表示するようなマクロを書いてくださいませんか?
今回いただいた記述と較べて、マクロの動きに手を加えたく思い、お願いいたします。。
m(_ _)m
マクロ記述を比較して、マクロを翻訳〔?〕する面白さを見つけました。
今一度、教えてください。
http://okwave.jp/qa/q8822141.html
No.4
- 回答日時:
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】セルに【行\列】を打ち込んだときに絶妙に〔行〕を〔列〕より低く、〔列〕を〔行〕より高く表示する術を教えてください。
No.2
- 回答日時:
>視覚的にさっと累計を把握したいのです
エクセルではそういう目的のために、「グラフ」という機能を利用することが出来ます。
ご相談で作成したいのは、グラフの種類の中から「横棒積み上げグラフ」というモノを利用します。
参考にしてください:
http://excel.ohugi.com/091005.htm
実際にやってみると判りますが、長々と■を連ねたり、延々とセルの塗色を積み重ねたりといった融通の利かないやり方は苦労ばかり多くてあまり見た目もよくありません。

早速のご回答ありがとうございます。
実際に、作成されたことに感謝致します。
「横棒積み上げグラフ」は、素晴らしいと思います。
グラフにはしばらく触れていなかったので、私の実務で応用できるか試行します。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) エクセルで”入力シート”の文字書式の変更を”出力シート”で同じ文字書式で印刷したいです。VBA希望 4 2023/04/24 11:07
- Excel(エクセル) エクセルシートの合計の変動 5 2022/04/05 15:56
- Excel(エクセル) IF 関数で「〇〇 という文字を含む場合」の分岐処理で表示された数字はSUMで数字集計できますか? 3 2022/08/02 16:29
- その他(Microsoft Office) 従業員増減対応で当番種類の増減対応な当番表 21 2022/07/19 07:30
- Excel(エクセル) エクセルの条件付き書式 個人シートを参照して集計シートに色付けしたい 1 2023/06/22 00:39
- Excel(エクセル) 半角ハイフンを除いた重複に色を付ける数式について 5 2022/09/08 20:43
- Excel(エクセル) エクセルの関数について 5 2023/04/30 17:24
- Excel(エクセル) excel 表計算 加算するセルが空白の時累計を表示しない又は塗りつぶして表示しないようにしたい 4 2023/07/02 11:50
- Excel(エクセル) エクセルで教えて下さい。 2 2022/05/18 13:00
- Excel(エクセル) セルに特定の色が出た時だけ、式を発動させたい 4 2022/06/17 10:32
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・一番好きなみそ汁の具材は?
- ・泣きながら食べたご飯の思い出
- ・「これはヤバかったな」という遅刻エピソード
- ・初めて自分の家と他人の家が違う、と意識した時
- ・いちばん失敗した人決定戦
- ・思い出すきっかけは 音楽?におい?景色?
- ・あなたなりのストレス発散方法を教えてください!
- ・もし10億円当たったら何に使いますか?
- ・何回やってもうまくいかないことは?
- ・今年はじめたいことは?
- ・あなたの人生で一番ピンチに陥った瞬間は?
- ・初めて見た映画を教えてください!
- ・今の日本に期待することはなんですか?
- ・集中するためにやっていること
- ・テレビやラジオに出たことがある人、いますか?
- ・【お題】斜め上を行くスキー場にありがちなこと
- ・人生でいちばんスベッた瞬間
- ・コーピングについて教えてください
- ・あなたの「プチ贅沢」はなんですか?
- ・コンビニでおにぎりを買うときのスタメンはどの具?
- ・おすすめの美術館・博物館、教えてください!
- ・【お題】大変な警告
- ・洋服何着持ってますか?
- ・みんなの【マイ・ベスト積読2024】を教えてください。
- ・「これいらなくない?」という慣習、教えてください
- ・今から楽しみな予定はありますか?
- ・AIツールの活用方法を教えて
- ・最強の防寒、あったか術を教えてください!
- ・歳とったな〜〜と思ったことは?
- ・モテ期を経験した方いらっしゃいますか?
- ・好きな人を振り向かせるためにしたこと
- ・スマホに会話を聞かれているな!?と思ったことありますか?
- ・それもChatGPT!?と驚いた使用方法を教えてください
- ・見学に行くとしたら【天国】と【地獄】どっち?
- ・これまでで一番「情けなかったとき」はいつですか?
- ・この人頭いいなと思ったエピソード
- ・あなたの「必」の書き順を教えてください
- ・14歳の自分に衝撃の事実を告げてください
- ・人生最悪の忘れ物
- ・あなたの習慣について教えてください!!
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excel2017 フィルタ昇順並びがA...
-
【Excel VBA】指定した行の最大...
-
エクセルで行の高さ及び列幅の...
-
基準日以前のデータを範囲を指...
-
EXCELで日付を比べ3か月以内の...
-
オートフィルタ後のデータから...
-
エクセルの時刻のカウントが出...
-
文字列を比較し、相違するフォ...
-
急ぎ!色のついたセルを非表示...
-
Excelで並び替え後にア行...
-
プルダウンに【なし、平均、デ...
-
Excelで任意の文字列を半角スペ...
-
エクセル関数について
-
エクセル 複数行ある同一商品...
-
Excelの数式について
-
エクセルで2つの郵便番号を比較...
-
excel / ピポッド 日数を出したい
-
Excel VBAでセルのクリアが出来...
-
エクセルで文字を含む式に、カ...
-
エクセルで円グラフに引き出し...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excel2017 フィルタ昇順並びがA...
-
エクセルで行の高さ及び列幅の...
-
Excelで並び替え後にア行...
-
【Excel VBA】指定した行の最大...
-
急ぎ!色のついたセルを非表示...
-
文字列を比較し、相違するフォ...
-
基準日以前のデータを範囲を指...
-
オートフィルタ後のデータから...
-
エクセルの時刻のカウントが出...
-
マクロで行の高さを設定したい
-
EXCELで日付を比べ3か月以内の...
-
VBA 複数行の検索及び抽出
-
エクセル関数について
-
EXCEL 最終行のデータを他のセ...
-
excel / ピポッド 日数を出したい
-
エクセル 複数行ある同一商品...
-
プルダウンに【なし、平均、デ...
-
エクセル VBA 行間隔を飛ばした...
-
Excel 最小二乗法 二次関数
-
検索条件に合うセルの個数を数...
おすすめ情報