Excel VBA質問箱 IV

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

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


6031 / 13646 ツリー ←次へ | 前へ→

【47575】セル(or列)がグループ化されているかどうか ひげくま 07/3/15(木) 11:53 質問[未読]
【47578】Re:セル(or列)がグループ化されているかど... ハチ 07/3/15(木) 12:48 発言[未読]
【47579】Re:セル(or列)がグループ化されているかど... ひげくま 07/3/15(木) 12:50 発言[未読]
【47580】Re:セル(or列)がグループ化されているかど... ウッシ 07/3/15(木) 12:54 回答[未読]
【47583】Re:セル(or列)がグループ化されているかど... ひげくま 07/3/15(木) 13:06 お礼[未読]
【47586】Re:セル(or列)がグループ化されているかど... ひげくま 07/3/15(木) 13:32 お礼[未読]

【47575】セル(or列)がグループ化されているかどう...
質問  ひげくま  - 07/3/15(木) 11:53 -

引用なし
パスワード
   セル(or列)がグループ化されているかどうかを調べたいのですが、可能でしょうか?

具体的には、

  A   B  C D E F G  H  I J K  L  M N O P Q R
1   TEAM-A 1 2 3 4 5 TEAM-B 1 2 3 TEAM-C 1 2 3 4 5 6 ・・・
2 3/15
3 3/16
4 3/17



というように、
日付 チーム名 各メンバー名 チーム名 各メンバー名 ・・・
という、各チームのMTG日を決める表を作りました。
C:G、I:K、M:Rはグループ化しています。

各メンバーの都合(○、△、×、等々)を書き込み、誰か一人でも×だったら、チーム名のところが×になるようにしたいです。

たとえば、D3に何かが書き込まれたら、C3:G3を調べて、一つでも×があったら、B3に×を書き込み、×が一つもなかったら、B3をクリアする。
たとえば、J4に何かが書き込まれたら、I4:K4を調べて、一つでも×があったら、H4に×を書き込み、×が一つもなかったら、H4をクリアする。

現在は、Changeイベントで、一応そういうマクロは組んでいるのですが、TargetがC:GかI:KかM:Rだった場合に・・・というように、絶対座標で判断しています。

ただ、チームが固定ではなく増減し、メンバー数も変わるので、それに合わせてマクロも書き直さなければなりません。

もし、「書き込まれたセルがグループ化されていた場合に、同一グループの同一行を調べて・・・」というようなマクロが組めれば、チームの増減やメンバー数が変わったときでも、マクロを書き直す必要がないので、とても便利になります。

ということで改めて質問です。
セル(or列)がグループ化されているかどうかを調べたいのですが、可能でしょうか?

よろしくお願いします。

【47578】Re:セル(or列)がグループ化されているか...
発言  ハチ  - 07/3/15(木) 12:48 -

引用なし
パスワード
   ▼ひげくま さん:
>セル(or列)がグループ化されているかどうかを調べたいのですが、可能でしょうか?

グループ化とされていると判定する規準はなんですか?
セルに名前をつけてる とか
どこかの範囲が結合されてる とか

それがわかれば、できそうですね。

それとも集計のグループのことですか?
提示されている内容からだと違いそうですが・・

【47579】Re:セル(or列)がグループ化されているか...
発言  ひげくま  - 07/3/15(木) 12:50 -

引用なし
パスワード
   ▼ハチ さん:
>それとも集計のグループのことですか?
>提示されている内容からだと違いそうですが・・

集計のグループのことです。
集計が目的ではなく、各メンバー名を消して、チーム名だけの表を見たいときに便利なので、グループ化しています。

【47580】Re:セル(or列)がグループ化されているか...
回答  ウッシ  - 07/3/15(木) 12:54 -

引用なし
パスワード
   こんにちは

グループ化使う事ないので、これでいいのかどうか分かりませんけど、

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim i As Long
  Dim t As Long
  Dim s As Long
  Dim e As Long
  Dim r As Range
  Dim v As Variant
  
  With Target
    If .Cells.Count > 1 Then Exit Sub
    If .Columns(1).OutlineLevel < 2 Then Exit Sub
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    t = .Column
    For i = t - 1 To 2 Step -1
      If Me.Cells(1, i).Columns(1).OutlineLevel = 1 Then
        s = Me.Cells(1, i).Column
        Exit For
      End If
    Next
    For i = t + 1 To Me.Columns.Count
      If Me.Cells(1, i).Columns(1).OutlineLevel = 1 Then
        e = Me.Cells(1, i).Column
        Exit For
      End If
    Next
    Set r = Me.Range(Me.Cells(.Row, s + 1), Me.Cells(.Row, e - 1))
    v = Application.Match("×", r, 0)
    If IsError(v) Then
      Me.Cells(.Row, s).ClearContents
    Else
      Me.Cells(.Row, s).Value = "×"
    End If
  
    Application.EnableEvents = True
    Application.ScreenUpdating = True
  
  End With
End Sub

【47583】Re:セル(or列)がグループ化されているか...
お礼  ひげくま  - 07/3/15(木) 13:06 -

引用なし
パスワード
   ▼ウッシ さん:
>    If .Columns(1).OutlineLevel < 2 Then Exit Sub

OutlineLevel というプロパティがあったんですね!
これで解決しました。

勉強になりました。
どうもありがとうございました。

【47586】Re:セル(or列)がグループ化されているか...
お礼  ひげくま  - 07/3/15(木) 13:32 -

引用なし
パスワード
   このコードで実現できました。
どうもありがとうございました。

Private Sub Worksheet_Change(ByVal Target As Range)

  Application.EnableEvents = False
  
  Dim colx As Long
  Dim str As String
  
  If Target.EntireColumn.OutlineLevel > 1 Then
    colx = 1
    Do Until Target.Offset(0, colx).EntireColumn.OutlineLevel = 1
      colx = colx + 1
    Loop
    
    str = ""
    colx = colx - 1
    Do Until Target.Offset(0, colx).EntireColumn.OutlineLevel = 1
      If Target.Offset(0, colx).Value = "×" Then str = "×"
      colx = colx - 1
    Loop
    
    Target.Offset(0, colx).Value = str
  End If
  
  Application.EnableEvents = True

End Sub

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