[[20151001172241]]　『重複する項目の個数を足したい』（ぬくい）　ページの最後に飛ぶ

『重複する項目の個数を足したい』（ぬくい）

重複している項目を足して整理したいのでお力をお借りしたいです。
ユーザーフォームで表示したいと思っていますので、VBAやる方法などありますでしょうか。

A列に名前を入れて、Bにははじめの個数、減っていくにつれて、C列とD列…と個数を横に書いて行っています。現在のそれぞれの総数を数を調べたいです。

A-----B-----C-----D
あ　　5　　　4　　3
い　　6　　　4
う　　5
え　　7　　　3
お　　3　　　2　　1
お　　7　　　3
え　　4
う　　6　　　5
い　　9　　　7
あ　　2　　　1　　0

結果
あ　　6
い　　11
う　　10
え　　7
お　　4

よろしくお願いいたします。

＜使用 Excel：Excel2013、使用 OS：Windows7 ＞

 あ　が 6 とありますが、これは 3 の間違いですか？

（β） 2015/10/01(木) 17:48

 アップ後、行が名前だけであとは空っぽだった時のエラー回避でちょこっと変更。

 6 が 3 の間違いだとして。

 結果は、現在の表の領域から１列間をあけた右側に記載します。
 (表の大きさは自動判定しています）

 Sub Test()
    Dim r As Range
    Dim dic As Object
    Dim k As String

    Set dic = CreateObject("Scripting.Dictionary")

    With Range("A1").CurrentRegion
        For Each r In .Resize(, .Columns.Count + 1).Rows
            k = r.Cells(1).Value
            dic(k) = dic(k) + Val(r.Cells(r.Cells.Count).End(xlToLeft).Value)
        Next

        Cells(1, .Columns.Count + 2).Resize(dic.Count).Value = WorksheetFunction.Transpose(dic.keys)
        Cells(1, .Columns.Count + 3).Resize(dic.Count).Value = WorksheetFunction.Transpose(dic.items)

    End With

 End Sub

（β） 2015/10/01(木) 17:59

	A	B	C	D	E	F	G
1	あ	5	4	3		あ	3
2	い	6	4			い	11
3	う	5				う	10
4	え	7	3			え	7
5	お	3	2	1		お	4
6	お	7	3				
7	え	4					
8	う	6	5				
9	い	9	7				
10	あ	2	1	0			
11

 G1 =SUMPRODUCT(N(OFFSET(A$1,ROW(A$1:A$100)-1,MMULT((B$1:D$100<>"")*1,{1;1;1})))*(A$1:A$100=F1))
 下へコピー。
（GobGob） 2015/10/02(金) 09:10

 ＞VBAやる方法などありますでしょうか。

 あー。失礼しましたｗ。
　
（GobGob） 2015/10/02(金) 09:13

 Sub test()
    Dim a, i As Long, ii As Long, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    With Cells(1).CurrentRegion
        a = .Value
        For i = 1 To UBound(a, 1)
            For ii = UBound(a, 2) To 2 Step -1
                If a(i, ii) <> "" Then dic(a(i, 1)) = dic(a(i, 1)) + a(i, ii): Exit For
        Next ii, i
        .Offset(, .Columns.Count + 2).Resize(dic.Count, 2).Value = _
        Application.Transpose(Array(dic.keys, dic.items))
    End With
End Sub
（seiya） 2015/10/02(金) 09:55

 >>Application.Transpose(Array(dic.keys, dic.items))

 なぁるほど！　です。今後、パクらせていただきます。

（β） 2015/10/02(金) 12:16

β様
あの個数は3ですね…計算できないなんてお恥ずかしい。
コピーぺして実行してみました。
完璧です。
とても助かりました。
1行目にタイトルを入れ忘れていたので、自分で改良してみます。
ありがとうございました。

GobGob様
簡易的に調べるのにはいいかもしれません。
VBAやマクロが苦手な人に渡すときに使わせていただきます。
ありがとうございました。

seiya様
色々な方法があるんですね。
VBAを勉強し始めたばかりでまだまだわからないことも多いので、解読してお勉強させていただきます。
ありがとうございました。
（ぬくい） 2015/10/02(金) 12:41

コメント返信：

[ 一覧(最新更新順) ]

[[20151001172241]] 『重複する項目の個数を足したい』（ぬくい） ページの最後に飛ぶ

[[20151001172241]]　『重複する項目の個数を足したい』（ぬくい）　ページの最後に飛ぶ