[[20180606113115]] 『条件(文字の一致)にあった行の特定フィールドの』(ゴジラ) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『条件(文字の一致)にあった行の特定フィールドのデータ数のカウント』(ゴジラ)

 A    B    C   D
ぶどう うさぎ ネコ 
みかん いぬ  
ぶどう ゴリラ ネコ うさぎ
キウイ うさぎ ネコ 

上記のような表で、A列を条件としてBからDまでのフィールドのデータの個数をカウントしたいのですが、なかなかうまくできません。

上記の例だと以下のような情報が欲しいと思っています。
ぶどう:5
みかん:1
キウイ:2

Dcountaで色々試したのですがお手上げになってしまいました。
どなたかご存知の方がおられましたらご教授のほどどうぞよろしくお願い致します。

< 使用 Excel:Excel2016mac、使用 OS:MacOSX >


 A10セルから下にぶどう、みかん、キウイと入力されているとして。
 B10セルに
 =SUMPRODUCT((A$1:A$4=A10)*(B$1:D$4<>""))
 と入力して下へフィルコピーではどうか?
(ねむねむ) 2018/06/06(水) 11:50

 VBA ^^。。。

 もっとスマートな方法は有ろうかと存じますが。
バックアップ必須! ^^;;;

 Option Explicit
Sub main()
    Dim sh01 As Worksheet, ws As Worksheet, wb As Workbook
    Dim i As Long, j As Long, cnt As Long, buf, rr As Range
    Dim y As Long, k As Long
    Set sh01 = Worksheets("Sheet1")
    sh01.Range("J1").CurrentRegion.ClearContents
    sh01.Copy
    Set wb = ActiveWorkbook
    Set rr = ActiveSheet.Range("A1").CurrentRegion
    rr.RemoveDuplicates 1, xlNo
    rr.Range(rr(1, 2), rr(rr.Rows.Count, rr.Columns.Count)).Clear
    buf = rr.SpecialCells(xlCellTypeConstants)
    wb.Close SaveChanges:=False
    Set rr = sh01.Range("A1").CurrentRegion
    y = 1
    For i = 1 To UBound(buf, 1)
        For j = 1 To rr.Rows.Count
            If buf(i, 1) = rr(j, 1) Then
                For k = 2 To rr.Columns.Count
                    If rr(j, k) <> "" Then
                        cnt = cnt + 1
                    End If
                Next
            End If
        Next
        sh01.Cells(y, 10) = buf(i, 1)
        sh01.Cells(y, 11) = cnt
        cnt = 0
        y = y + 1
    Next
End Sub
(隠居じーさん) 2018/06/06(水) 13:35

Sub main()
'Sheet1からSheet2に集計
    Dim dic As Object, k As Variant, c As Range
    Set dic = CreateObject("Scripting.Dictionary")
    For Each c In Sheets("Sheet1").Range("A:A").SpecialCells(2)
        dic(c.Value) = dic(c.Value) + WorksheetFunction.CountA(c.Offset(, 1).Resize(, 3))
    Next c
    Sheets("Sheet2").Cells.Clear
    Sheets("Sheet2").Range("A1").Resize(dic.Count, 2) = WorksheetFunction.Transpose(Array(dic.keys, dic.items))
End Sub
(mm) 2018/06/06(水) 18:11

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.