『色付セル範囲の「特定項目」を抽出して合計したい』(亜麻) こんにちわ。 検索で上手くひっかからなかったのですが、既出でしたら申し訳ございません。 OS:2000(SP4) エクセル:2000 下記のような状態のエクセルシートがあります。 A B C D E F 1 社*** 区分 数量 個*** 区分 数量 2 個*** 区分 数量 車*** 区分 数量 3 車*** 区分 数量 社*** 区分 数量 4 車*** 区分 数量 社*** 区分 数量 5 個*** 区分 数量 車*** 区分 数量 以下続く このような感じで表が配置されています。 印刷の都合で、このような配置となってます。 (で、これが縦にずらーっと長くなり、数ページ分になってます) 今、資料に基づき A3〜C3、D1〜F1、D3〜F3に色(うすピンク)が、 A2〜C2、A5〜C5、D4〜F4に色(うす黄色)がそれぞれ塗られています。 A列、D列が項目名で、***の部分には任意の英数字が入っています。 ここで ・A列・D列の項目名毎の数量(C列・F列)の合計 ・A列・D列の項目名毎でかつ「うすピンクセル」「うす黄色セル」「無色セル」の区分でそれぞれ数量(C列・F列)の合計をしたいのですが、どのようにすれば可能でしょうか? 当方、LOOKUPとSUMIFはどうにか使えますが、VBAは全然です。 印刷の都合でこのようになってはいますが、本来は1つの表ですので、 できれば一回で「このシート内での」合計をだしたいのですが。 お手数ですがご指導の程、宜しくお願い致します。 ---- >既出でしたら申し訳ございません。 既出です。↓学校内全文検索より [色のついたセル 集計] http://www.excel.studio-kazu.jp/cgi-bin/estindex/estseek2.cgi?phrase=%E8%89%B2%E3%81%AE%E3%81%A4%E3%81%84%E3%81%9F%E3%82%BB%E3%83%AB%E3%80%80%E9%9B%86%E8%A8%88&perpage=100&attr=@uri+STRINC+kazuwiki&order=@uri+STRD&clip=-1 (みやほりん)(-_∂)b ---- こんにちわ 早速のご教示ありがとうございました。 が。 条件が「色つき」だけではないもので、求める条件を組み合わせる方法などがわかりませんで・・・。 (表示いただいたところは全て目を通してみたのですが) 「特定色の」「特定文字を含む」範囲で「数値を参照」して「合計」させるには何をどのように組み合わせればよいのかが見えてこず、困っています。 先ほど調べたところ、当方のPCには「VBAエディタのヘルプ」がインストールされてなく(管理者にお願いしましたが、レンタルPCなので手配に今しばらくかかるとのことで・・・)必要な関数を自力で調べるのもままならないという情けない状況です。 お手数ですが、 1)方法論 2)必要な関数等 のヒントだけでも結構です。 ご教示願えませんでしょうか。 宜しくお願い致します。 ---- 以前作ったものですが、色で抽出したものを他のシートに書き出して、 書き出した先のシートで、オートフィルを使って抽出してはどうでしょうか。 http://skyblue123.hp.infoseek.co.jp/Excel/ColorFilter2.xls (川野鮎太郎) ---- 1)色には頼らない Excelワークシート関数は「色」を基準に計算ができません。 セルの色っていうのはExcelでは「おまけ」程度の機能です。 現実にも色というのは人によって(または機械の性能によって)「感じ方が違う」もの です。「うす黄色」と「無色」の違いがわからない人もいるかもしれません。 「人間の感覚に依存する方法はいかん」、という設計者の主義かもしれません。 マクロに関わりたくなければ、「なぜ色が変えてあるか」その理由(条件)を 考えてみてください。 理由がわかれば数式的に表現できるはずです。 数式的に表現されうるものであれば関数で計算できます。   逆に言うと色のついている理由が表現できなければ、具体的な関数での処理を 表現することはできませんが、 「テキトーに色をつけたりしてみたんだけどぉ、なんとなーく色つきのとこだけ 足してみたくなっちゃったりしてぇ・・・」ってことではないはず。   2)Color関数 エクセルの学校ダウンロードコーナーに色つきセルの処理関数があるので、 それを利用するのもよし。(結局はマクロですが) http://www.excel.studio-kazu.jp/DL/#q10   3)複数条件での集計 次の数式は 「範囲1が1であり、かつ、範囲2が"特定文字"である、範囲3の数値の合計」 を行います。 =SUMPRODUCT((範囲1=1)*(範囲2="特定文字")*(範囲3))   「特定色(であることを表現する範囲1)の」「(範囲2で)特定文字を含む」範囲で「(範囲3の)数値を参照」して「合計」 という計算に応用できます。   「特定色であることを表現する範囲1」を作るには↓のような方法もあります。 http://miyahorinn.fc2web.com/faq/faq030.html が、「色付けの条件」が数式的に表現できれば、そんなまどろっこしい方法はいりま せん。(範囲1=1)の部分を「色付けの条件を判断する数式」とすればよいのですから。   (みやほりん)(-_∂)b ---- これは亜麻さん用に作ったユーザー関数です。 みやはんのご高説はご高説として、こんな事もでけんことは無いっちゅう程度で 試してみておくんなはれ。    H      I     J      K        L 1 総計 うす黄色 うすピンク 色無し 2 社*** 3 個*** 4 車*** あんさんが呈示したデータをそのまま鵜呑みにしたとして 上の様な塩梅にデータ抽出テーブルを作成してくらはい。 I2=SUMPRODUCT(($A$1:$A$5=H2)*($C$1:$C$5))+SUMPRODUCT(($D$1:$D$5=H2)*($F$1:$F$5)) を下にコピーで総計は求められますわなぁ。 それから先は一旦下のコードを Alt+F11→挿入→標準モジュールの真っ白な画面に下のコードをコピペします。 へてから、J2へ=ama($A$1:$C$5,$D$1:$F$5,$H2,36)と記入します。 A1:C5,D1:F5(面倒やから$抜いてます)はお分かりですわなぁ。 $H2も何処を指してるかお分かりですわなぁ。 さあて、ここからですが36と有るのは色番号なんですわ。 マクロの記録ご存じでっか? あんさんの仰有るうす黄色がこの番号にあてはまるかどうかはマクロのきろくで  確認せなあきまへん。 それで求めたい色番号を確認したうえ、その番号を記入してくらはい。 勿論うすピンクもそうですよ。 色無しは0で結構です。ホンマはマクロ上xlNoneなんですがこの関数内で処理しとりま す。 そんな、こんなで12個のセルが埋まったらあんさんの求めとるデータが抽出でけた とおもいまんねんけど・・・ ただこれには大きな欠点がありましてナ、通常関数といえば即座に求める結果が反映 されるもんなんですけど、こと色事(あ、表現が適切でないか(笑))に関する作業 は残念ながら即座に反映しまへん。 参照する範囲の色を変更してもデータは元のままっちゅう訳ですわ、えぇ。 それを回避するにはCtrl+F9を利用するか、若しくはそのSheetモジュールに Private Sub Worksheet_SelectionChange(ByVal Target As Range) Calculate End Sub こんなコードを貼り付けなアキマヘン。 ま、ま、使う使わんは別としていっぺん試してみる価値はありまっせ。(笑    あ、しんど(弥太郎) '------------------- '当関数は色の付いたセルを一つ跨いだセルの合計を算出する関数です。 '入力方法は=ama($a$1:$c$5,$d$1:$f$5,$h2,36)等と記入します。 'A1からC5に入力されたデータでA列(C列まででもOK)に色づけされた '及びD1からF5まで同じような形式で入力された(いずれも3列目に合計値のある) 'データの指定した色番号を合計する処理であって一般的には使用するには不適です。 Function ama(adrs1 As Range, adrs2 As Range, adrs3 As Range, colrNo As Variant) Dim totl As Double Dim tbl1 As Range, tbl2 As Range Dim i As Long Application.Volatile Set tbl1 = adrs1 Set tbl2 = adrs2 If colrNo = 0 Then colrNo = xlNone For i = 1 To tbl1.Rows.Count m = tbl1(i, 1).Interior.ColorIndex If tbl1(i, 1) = adrs3.Value And tbl1(i, 1).Interior.ColorIndex = colrNo Then totl = totl + tbl1(i, 3).Value End If Next i For i = 1 To tbl2.Rows.Count If tbl2(i, 1) = adrs3.Value And tbl2(i, 1).Interior.ColorIndex = colrNo Then totl = totl + tbl2(i, 3) End If Next i ama = totl End Function ---- おはようございます。 皆様、色々とご教示ありがとうございます。 (勉強不足を痛感しております) >川野 様 ありがとうございます。 早速DL致しました。 視覚的に分かりやすく、使いやすいですね。 ありがとうございました。 >みやほりん 様 度々のご教示ありがとうございます。 説明不足がありましたようで・・・。 1)色付きの条件 この表は図面と連動したもので、色をつけてるのは 「視覚的に分かりやすく」「誰でも作業できる」からです。 カラー印刷の必要のある添付資料なのですが、流動的なデータで・・・。数式で表現するのは困難です。 (色表現については値の取得方法がその時点ではよくわかっていなかったからです) 一度、右欄に「数字」を入力(あるいはプルダウン)し、それに対して条件付書式を作成しようとしたのですが・・・。紆余曲折の末、この形に落ち着いたのです。 エクセル表としては不適切なのかもしれませんが・・・。 2)ただいま実験中です 3)なるほど・・・。こういう方法もあったのですね。 >弥太郎 様 ご丁寧にありがとうございます。 現在テスト中です。 (あまり理解のよくないアタマなので???と首を捻りすぎてスジを違えそうになってますが) VBAの入力画面がよく分からないので試行錯誤しながらテストしております。 本当にありがとうございました。 明日中には結果をお伝えできると思います。 (亜麻) ---- こんにちわ 皆様ご教示いただきありがとうございました。 いずれの方法でもどうにか目的のものを得ることができました。 ただ、みやほりん 様からご教示頂いたColor関数ですが・・・。 こちら、アドインを利用しているのですが、何故か再計算ができません?? CTRL+F9ではブックが最小化し、ページ記載のCTRL+Alt+Shift+F9では何も起こりません。 Win2k エクセル2000では何か違うキーを使わなければならないのでしょうか? ツール→マクロ のところを見てみましたがボタンが?? 付属のエクセルシートにUSClrReCalcというマクロがあるのですが、これが再計算用のものなのでしょうか?? (亜麻) ---- 再計算は F9 を押下です。 弥太郎氏の記入ミスと思われます。   また、UPされているColor*関数では次の一文がないために入力時のみ計算される 仕様だと記憶しています。 Application.Volatile 各プロシージャ先頭で次のように一文追加しておくか、 Public Function UFCl*(adrs, clr) Application.Volatile   もしくは、 アドインインストール時にメニューツールバーへ[Clr]というボタンが作成されている はずなのでこのボタンをクリックして再計算していただければよいかと思われます。   【私信】 残りの年貢はいただきます。<弥太郎氏 (みやほりん)(-_∂)b ---- ありゃまっ 今度からは、みやさんに年貢を払うのかしら??? それとも・・・ 両方だったりして〜(笑 ※亜麻さん、レス借りちゃいましたm(_ _)m (キリキ)(〃⌒o⌒)b ---- >残りの年貢はいただきます げっ、お代官様なんと理不尽・・・(笑 せやけど彼らの納め具合の悪いことというたらおまへんでぇ(笑 亜麻さんごめんなはれや。 えっと、私の関数をちょっとだけ変えてみましたワ。 前のんはカラーのインデックス番号を入力せなあきまへんでしたけど、新しいのんは J1、K1(勿論それ以上でもOK)にあんたはんの見たうす黄色、うすピンクで塗りつぶし たセルを参照して合計を拾い出します。 J2に=ama($A$1:$C$5,$D$1:$F$5,$H2,J$1)としてL4迄コピーの方法でOKです。 なお、再計算はF9でっせ、間違わんように(笑       (弥太郎) '---------------------------------- '当関数は色の付いたセルを一つ跨いだセルの合計を算出する関数です。 '入力方法は=ama($a$1:$c$5,$d$1:$f$5,$h2,$j1)等と記入します。 '↑に計算したい色を付ける 'A1からC5に入力されたデータでA列(C列まででもOK)に色づけされた '及びD1からF5まで同じような形式で入力された(いずれも3列目に合計値のある) 'データの指定した色番号を合計する処理であって一般的には使用するには不適です。 Function ama(adrs1 As Range, adrs2 As Range, adrs3 As Range, colrng As Range) Dim totl As Double Dim tbl1 As Range, tbl2 As Range Dim i As Long Dim colNo As Integer Application.Volatile Set tbl1 = adrs1 Set tbl2 = adrs2 colrNo = colrng.Interior.ColorIndex For i = 1 To tbl1.Rows.Count m = tbl1(i, 1).Interior.ColorIndex If tbl1(i, 1) = adrs3.Value And tbl1(i, 1).Interior.ColorIndex = colrNo Then totl = totl + tbl1(i, 3).Value End If Next i For i = 1 To tbl2.Rows.Count If tbl2(i, 1) = adrs3.Value And tbl2(i, 1).Interior.ColorIndex = colrNo Then totl = totl + tbl2(i, 3) End If Next i ama = totl End Function ---- 『解決!です』 皆様多数のご教示ありがとうございました。 今後は間違えずにF9で再計算いたします(笑) 目的のものが無事できましたので、ここで閉じます。 >みやほりん 様 毎々、ありがとうございます。 アドインをいれ直し、再起動してみた所、無事メニューバーに再計算キーが出てまいりました。 プロシージャ追加はまだ試していませんが、チャレンジしてみます。 >弥太郎 様 新コードのご提示ありがとうございます。 有り難く使わせていただきます。 書店にて、VBAの入門書他参考書籍を購入してみました。 資料作成業務も増加してきているので、本腰入れてやってみようと思います。 (図面だけでも結構作業量があるんですが・・・。) またお尋ねにあがるかもしれませんが、その際は宜しくお願い致します。 皆様お世話になりました。 ありがとうございました。 (亜麻)