使用例８

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


　

　


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