ステートメント制御文の使用例8


使用例8

出現値を重複なしで抽出し、該当する記号(○印)の件数をカウントする。
個人データの行列数が可変。さらに並べ替えも自動的に行うように拡張。


 

  Sub 抽出件数() Dim c As Range Dim la, lb As Integer Dim rs As Long With Worksheets(1) Application.ScreenUpdating = False 'ソート la = .Range("a1").CurrentRegion.Rows.Count 'データ最終行 lb = .Range("a1").CurrentRegion.Columns.Count 'データ最終列 r = .Rows.Count 'シート最終行 Range(Cells(2, 1), Cells(la, lb)).Select Selection.Sort _ Key1:=Cells(2, 1), _ Order1:=xlAscending, _ Header:=xlGuess, _ OrderCustom:=1, _ MatchCase:=False, _ Orientation:=xlTopToBottom, _ SortMethod:=xlPinYin '出現値を重複なしで抽出 With .Range("a1:a" & CStr(la)) For i = 1 To la Set c = .Find(i, LookIn:=xlValues) '新番号を検索 If Not c Is Nothing Then firstAddress = c.Address '最初の番号のアドレス Cells(r, lb + 2).End(xlUp).Offset(1).Select '入力行選択 Selection.Value = c.Value '検索番号を入力 Selection.Offset(, 1).Value = _ c.Offset(, 1).Value '対応する氏名を入力 End If Next i End With '該当の記号(○印)の件数をカウント lc = .Cells(1, lb + 2).CurrentRegion.Rows.Count For j = 1 To lc - 1 .Cells(j + 1, lb + 4).Value = _ "=SUMPRODUCT((a2:a" & la & "=" & j & ")*(" & Chr(64 + lb) & "2:" & Chr(64 + lb) & la & "=" & """○""))" 'つまりこの例では、H2 に『 =SUMPRODUCT((a2:a11=1)*(d2:d11="○")) 』が入力される Next j .Range("a1").Select Application.ScreenUpdating = True End With End Sub back top