Office:単一のセルからチェックボックスを数える
Excelでは、複数のチェックボックスオプション(アイテムリスト)を持つ単一のセルを含むスプレッドシートを使用しています.リスト内の特定のアイテムのチェックボックスをカウントすることは可能ですか? 2,000行を超えるデータがあります.
これは例です:
返信リスト(回答:7)
こんにちは、マイケル
ファイルを開く
列Jを再表示
VBAエディターを開く
通常のモジュールを追加する
以下のコードを貼り付けてください
実行する
結果は列Jにあり、空のセルはチェックボックスがオフであることを意味します.
アンドレアス.
Option Explicit
Sub CountCheckboxes()
Dim Ws As Worksheet
Dim Sh As Shape
Dim CB As CheckBox
Dim Item
Dim Y As Single
Dim D As Range、J As Range
Set Ws=ActiveSheet
'前の結果をクリア
Ws.Range( "J:J").Clear
Ws.Shapesの各Shに対して
ケースを選択Sh.Type
Case msoFormControl
If Sh.FormControlType=xlCheckBox Then
Set CB=Sh.DraWingObject
GoSub Count
End If
Case msoGroup
For Sh内の各アイテム.GroupItems
If Item.Type=msoFormControl Then
If Item.FormControlType=xlCheckBox Then
Set CB=Item.DraWingObject
GoSub Count
End If
End If
Next
End Select
Next
Exit Sub
Count:
'ボタンが明確に配置されているセルを計算します
'すべてのボタンは列Dにあるので、確認するだけです垂直位置
Y=CB.Top + CB.Height/2
Set D=Intersect(CB.BottomRightCell.EntireRow、Range( "D:D"))
Y
CB.Value=1の場合J=J + 1
Return
End Sub
応答2# ->にスキップ3 #Michaelハローアンドレアス、
この答えを提供してくれてありがとう.しかし、私は本当に別の質問をしていたと思います.
リストでチェックされている各ボックスをカウントしてカウントし、カテゴリを記録してください.例えば:
は次のように数えられます.
学生情報セッション-GROUP= 0
ワークショップ-なぜ大学?= 2
ワークショップ-大学の準備率= 1
ETC.
各行を要約してから総列を集計する方法はありますか?
マイケル
応答4# ->にスキップ5 #Michaelはい、そのとおりです.各コントロールごとのチェックボックスの総数を探しています(1.学生向け説明会、2.ワークショップ-なぜカレッジなのか、3.ワークショップ-カレッジの準備など...
マイケル
応答5# ->にスキップ6 #Andreasこんにちは、マイケル
以下のコードを試してください.
アンドレアス.
Option Explicit
Sub CountCheckboxes()
Dim Ws As Worksheet
Dim Sh As Shape
Dim CB As CheckBox
Dim Item、Items、Keys
Dim Dict As Object ' Scripting.Dictionary
Set Dict=CreateObject( "Scripting.Dictionary")
Dict.compareMode=vbTextcompare
Set Ws=ActiveSheet
各ShのWs.Shapes
ケースの選択Sh.Type
Case msoFormControl
If Sh.FormControlType=xlCheckBox Then
Set CB=Sh.DraWingObject
GoSub Count
End If
Case msoGroup
For Each Item in Sh.GroupItems
If Item.Type=msoFormControl Then
If Item.FormControlType=xlCheckBox Then
Set CB=Item.DraWingObject
GoSub Count
End If
End If
Next
End Select
Next
Items=WorksheetFunction.Transpose(Dict.Items)
Keys=WorksheetFunction.Transpose(Dict.Keys)
Sheets.Add After:= Ws
Range( "A1" ).Resize(UBound(Keys)).Value=Keys
Range( "B1").Resize(UBound(Items)).Value=Items
Range( "A:B").EntireColumn.AutoFit
Exit Sub
Co unt:
If CB.Value=1 Then
If Not Dict.Exists(CB.Caption)Then
Dict.Add CB.Caption、1
Else
Dict.Item(CB.キャプション)= Dict.Item(CB.Caption)+ 1
End If
End If
Return
End Sub