[[20080724093129]]　『色付の結合セルを１と数える方法』（カルロ）　ページの最後に飛ぶ

『色付の結合セルを１と数える方法』（カルロ）

 Excel2002,WindowsXP

      A        B        C       D        E
 1 　 3　   黄色セル         黄色セル 黄色セル 
   　　                        (セル結合)
 2    
　
 B1=黄色セル、D1:E1=黄色セルで結合している。
 A1=黄色セルの合計数

 下記のようなユーザー定義関数で計算した結果、結合したセルは、2と数えられます。
  Function 色付セル(adrs As Range)
    Dim c As Range, Cnt As Long
    Application.Volatile
    For Each c In adrs
        If c.Interior.ColorIndex = 6 Then    '黄色セル 件数
            Cnt = Cnt + 1
        End If
    Next c
     色付セル = Cnt
 End Function

 *** D1:E1=黄色セルで結合しているところは、1と数えたい。
 *** 結合したセルを1とかぞるには、どうしたらよいのでしょうか？
 過去の事例を拝見しましたが、掲載されていません。
 教えて下さい。よろしくお願いします。

 >結合したセルを1とかぞるには、どうしたらよいのでしょうか？
 結合しているかどうか、MergeCells プロパティで判断してはどうでしょう。
 ヘルプも探してみましょう。或いはキーワードに用いて下さい。
 （クルミ）

 クルミさんヒントを有難うございます。
 MergeCells プロパティでセル結合したセル数を調べることができました.
 しかし、セル結合しているセルは、1ヶ所ではなく、数箇所あります。
 セル結合:
 D1:E1=黄色セルで結合(2つのセルを結合)、
 F1:I1=黄色セルで結合(4つのセルを結合)のように結合セル数もランダムです。

 下記のように書けば、結合したセルが、6つになります。
 結合したセルの合計数で表現されます。

 Function 結合セル(adrs As Range)
    Dim c As Range, Cnt As Long
    Application.Volatile
    For Each c In adrs
        If c.MergeCells Then 'セル結合しているセル
           Cnt = Cnt + 1
        End If
    Next c
    結合セル = Cnt
 End Function

 結合セル数は、わかりますが、それで結局２箇所のセルが結合
 していることを計算するには、どうしたらよいのでしょう？
 良い方法がありましたら、教えて下さい（カルロ）

 セルを結合すると計算式を作るにしても、マクロを作成するにしても、何かと厄介な
 問題が絡んできます。
 いっその事結合を解いてやればなんの問題もおこりまへんから、さうしませう。

 と言うてしまえば愛想もクソもないんで・・・
 　　　　（弥太郎）
  Function 色付セル(adrs As Range)
    Dim c As Range, r As Range, Cnt As Long, u As Long, x()
    Application.Volatile
    For Each c In adrs
        If c.Interior.ColorIndex = 6 Then    '黄色セル 件数
            Cnt = Cnt + 1
            If c.MergeCells = True Then
                On Error Resume Next
                If IsError(Application.Match(c.Address, x, 0)) Then
                    For Each r In c.MergeArea
                        ReDim Preserve x(u)
                        x(u) = r.Address
                        u = u + 1
                    Next r
                Else
                    Cnt = Cnt - 1
                End If
            End If
        End If
    Next c
    色付セル = Cnt
    On Error GoTo 0
 End Function

 考え方だけですけど・・・。
 後は適当に手を加えてください。
 BJ

 Dim Rg As Range
 For Each Rg In Range("A1:G15")
    If Rg.Interior.ColorIndex = 6 Then
       If Rg.Address = Rg.MergeArea.Cells(1).Address Then
          ct = ct + 1
       End If
    End If
 Next
 MsgBox ct

 BJさん回答有難うございます。試してみましたらパッチリＯＫでした。
 有難うございました。今後共　よろしくお願いします（カルロ）

コメント返信：

[ 一覧(最新更新順) ]

[[20080724093129]] 『色付の結合セルを１と数える方法』（カルロ） ページの最後に飛ぶ

[[20080724093129]]　『色付の結合セルを１と数える方法』（カルロ）　ページの最後に飛ぶ