Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


4023 / 13644 ツリー ←次へ | 前へ→

【58806】色つきセルの数を数えたい okuyotim 08/11/11(火) 15:52 質問[未読]
【58807】Re:色つきセルの数を数えたい マクロマン 08/11/11(火) 15:57 発言[未読]
【58808】Re:色つきセルの数を数えたい マクロマン 08/11/11(火) 16:00 発言[未読]
【58809】Re:色つきセルの数を数えたい okuyotim 08/11/11(火) 16:21 質問[未読]
【58810】Re:色つきセルの数を数えたい マクロマン 08/11/11(火) 16:27 発言[未読]
【58811】Re:色つきセルの数を数えたい okuyotim 08/11/11(火) 16:45 質問[未読]
【58812】Re:色つきセルの数を数えたい マクロマン 08/11/11(火) 16:55 発言[未読]

【58806】色つきセルの数を数えたい
質問  okuyotim  - 08/11/11(火) 15:52 -

引用なし
パスワード
   エクセルで色つきのセルの数を数えたいのですが、
どうすればよいでしょうか? 色の種類別に数を
カウントしたいです。またセルに罫線(下線)が入っている
ものの数はどうやってカウントすればよいでしょうか?
VBA初心者です。よろしくお願いいたします。

【58807】Re:色つきセルの数を数えたい
発言  マクロマン  - 08/11/11(火) 15:57 -

引用なし
パスワード
   色付きセルのカウントです。

単純なのは、セル範囲をループし、隣のセルにでもセルの
Interior.ColorInDex '背景色
Font.ColorIndex '文字色
を転記していくことです。
あとでフィルタオプションの設定で種類を取得し、
種類ごとにCountIf関数で合計を出します。

【58808】Re:色つきセルの数を数えたい
発言  マクロマン  - 08/11/11(火) 16:00 -

引用なし
パスワード
   こちらもご紹介しておきます。

色のついたセルをカウント・集計
tp://miyahorinn.fc2web.com/faq/faq030.html

【58809】Re:色つきセルの数を数えたい
質問  okuyotim  - 08/11/11(火) 16:21 -

引用なし
パスワード
   早速レスありがとうございます。
マクロマンさんに教えていただいたホームページは
既に閲覧済みだったのですが、そこに書かれているように
一旦別のセルに色番号を出さずに、一発で一つのセルに
カウント数を入力できるようにしたいのです。
今、A1からBD127の範囲に数種類の色のついたセルがあります。
その色ごとにカウントして数を入力したいです。
よろしくお願いいたします。

【58810】Re:色つきセルの数を数えたい
発言  マクロマン  - 08/11/11(火) 16:27 -

引用なし
パスワード
   一旦2次元配列に色番号を格納し、1次元目の色番号とマッチしたら
2次元目のカウントをカウントアップしていく、というのはいかがで
しょう?

未検証ですがいけると思います。

【58811】Re:色つきセルの数を数えたい
質問  okuyotim  - 08/11/11(火) 16:45 -

引用なし
パスワード
   すみません、初心者なので2次元配列も意味が分からず
ネットで調べている状態です。格納という意味もよくわかりません。
もう少し勉強してみます。

【58812】Re:色つきセルの数を数えたい
発言  マクロマン  - 08/11/11(火) 16:55 -

引用なし
パスワード
   選択セル範囲の色番号と各色番号のセルの数を取得しメッセージボックス
に表示します。

配列は一見複雑ですが、慣れれば難しくはないし便利です。

Sub iroitiran()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim c As Range
Dim r As Range
Dim iroary() As Variant
Dim myindx As String
Dim bl As Boolean
Dim msgstr As String
 Set r = Selection
 i = -1
 For Each c In r
  myindx = c.Interior.ColorIndex
  If myindx = xlNone Then myindx = "-"
  If i = -1 Then
   i = 0
   ReDim Preserve iroary(1, 0 To i)
   iroary(0, i) = myindx
   iroary(1, i) = 1
  Else
   bl = False
   For j = 0 To i
    If iroary(0, j) = myindx Then
     iroary(1, j) = iroary(1, j) + 1
     bl = True
     Exit For
    End If
   Next j
    If bl = False Then
     i = i + 1
     ReDim Preserve iroary(1, 0 To i)
     iroary(0, i) = myindx
     iroary(1, i) = 1
    End If
  End If
 Next c
 For k = 0 To i
  If msgstr <> "" Then msgstr = msgstr & vbCrLf
  msgstr = msgstr & iroary(0, k) & ":" & iroary(1, k)
 Next k
 MsgBox msgstr
 Erase iroary
End Sub

4023 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free