[[20190311140702]]　『部分一致した場合表に出力』（もも）　ページの最後に飛ぶ

『部分一致した場合表に出力』（もも）

データシートA列の値が、一覧シートA列と部分一致した場合にB列に集計結果を出すマクロを組みたいです。

【一覧シート】

A　　　　　　　B
株式会社赤川
葛西株式会社
宇野(株)
(株)東洋
中野製作所

【データシート】

A　　　　　　　B
株式会社赤川　 10000
葛西　　　　　 20000
赤川　　　　　 12000
宇野　　　　　 30000
葛西株式会社　 12300
中野　　　　　 15000
東洋　　　　　 20000

sumifで行っていたのですが、行が多いため処理速度を上げるためにマクロで行いたいです。ご教授ください。

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

 興味本位なのだがSUMIF関数でどのような式で合計を求めたのだろうか？
 （私ではSUMPRODUCT関数とCOUNTIF関数ので組み合わせしか思い浮かばなかった）
（ねむねむ） 2019/03/11(月) 16:00

最初は量が少なかったので「赤川」で検索して該当するデータ名を人力でsumifで足していました。
かなりアナログでした
（もも） 2019/03/11(月) 16:41

 行数は何行くらいになるのだろうか？
（ねむねむ） 2019/03/11(月) 16:44

1500行ほどです
（もも） 2019/03/11(月) 16:51

 それくらいの行数であれば一覧シートのB1セルに
 =SUMPRODUCT(COUNTIF(A5,"*"&データシート!A$1:A$1600&"*")*データシート!B$1:B$1600)
 と入力して下へフィルコピーではどうだろうか？
（ねむねむ） 2019/03/11(月) 16:59

やってみましたが#VALUEになっていまいます。。
（もも） 2019/03/11(月) 17:15

Sub main()

    'シート名は、一覧とデータ
    Dim dt As Variant, x, c As Range, cc As Range
    ReDim dt(Sheets("データ").Range("A:A").SpecialCells(2).Count)
    ReDim x(Sheets("一覧").Range("A:A").SpecialCells(2).Count)
    For Each c In Sheets("データ").Range("A:A").SpecialCells(2)
        For Each cc In Sheets("一覧").Range("A:A").SpecialCells(2)
            If InStr(cc.Value, c.Value) > 0 Then
                If dt(c.Row) <> "" Then
                    MsgBox c.Value & c.Offset(, 1).Value & "の候補が複数あります。(" & c.Row & "行目)" & vbLf & vbLf & cc.Value & vbLf & dt(c.Row) & vbLf & vbLf & "リストを訂正して再試行してください": Exit Sub
                Else
                    x(cc.Row) = x(cc.Row) + Val(c.Offset(, 1).Value)
                    dt(c.Row) = cc.Value
                End If
            End If
        Next cc
    Next c
    For Each cc In Sheets("一覧").Range("A:A").SpecialCells(2)
        cc.Offset(, 1).Value = x(cc.Row)
    Next cc
End Sub
（mm） 2019/03/11(月) 17:18

 =SUMPRODUCT(COUNTIF(A1,"*"&Sheet2!A$1:A$1600&"*"),Sheet2!B$1:B$1600)
 とするとどうなるだろうか？
 これで結果が出る場合、データシートのB列に文字が混じっている可能性がある。
（ねむねむ） 2019/03/11(月) 17:20

ｍｍさま

わかりやすくA列B列としていましたが

一覧シート
A列　B列　→　C列　J列

データシート
A列　B列　→　L列　K列

でしたので、わかる範囲で直しましたが、

x(cc.Row) = x(cc.Row) + Val(c.Offset(, -1).Value)

の部分でエラーになってしまいます。

↓直したコードです

Sub main()

    'シート名は、一覧とデータ
    Dim dt As Variant, x, c As Range, cc As Range
    ReDim dt(Sheets("データ").Range("L:L").SpecialCells(2).Count)
    ReDim x(Sheets("一覧").Range("C:C").SpecialCells(2).Count)
    For Each c In Sheets("データ").Range("L:L").SpecialCells(2)
        For Each cc In Sheets("一覧").Range("C:C").SpecialCells(2)
            If InStr(cc.Value, c.Value) > 0 Then
                If dt(c.Row) <> "" Then
                    MsgBox c.Value & c.Offset(, -1).Value & "の候補が複数あります。(" & c.Row & "行目)" & vbLf & vbLf & cc.Value & vbLf & dt(c.Row) & vbLf & vbLf & "リストを訂正して再試行してください": Exit Sub
                Else
                    x(cc.Row) = x(cc.Row) + Val(c.Offset(, -1).Value)
                    dt(c.Row) = cc.Value
                End If
            End If
        Next cc
    Next c
    For Each cc In Sheets("一覧").Range("C:C").SpecialCells(2)
        cc.Offset(, 7).Value = x(cc.Row)
    Next cc
End Sub
（もも） 2019/03/11(月) 17:34

ねむねむさま

訂正しましたが#VALUEのままです。。。
（もも） 2019/03/11(月) 17:36

 データシートのB列に#VALUE!エラーになっているセルがないだろうか？
（ねむねむ） 2019/03/12(火) 09:06

 多分、これ。
 =""
（BJ） 2019/03/12(火) 13:37

ねむねむさま

確認しましたがないです。

BJさま

勉強不足で式のどこの部分のお話かわかりません。。。
（もも） 2019/03/12(火) 15:13

 そうするとあとは
 Sheet2!A$1:A$1600
 と
 Sheet2!B$1:B$1600
 のサイズが異なっている（片方がA1:A100で片方がB2:B100など）くらいしか思いつかないのだが…
（ねむねむ） 2019/03/12(火) 15:33

 B列に数式で "" となるようなところがある事はないですか？
 あれば、

 =SUMPRODUCT(COUNTIF(A1,"*"&Sheet2!A$1:A$1600&"*"),Sheet2!B$1:B$1600)
　↓
 =SUMPRODUCT((COUNTIF(A1,"*"&Sheet2!A$1:A$1600&"*"))*(Sheet2!B$1:B$1600<>""),Sheet2!B$1:B$1600)
 かな？
 無ければ、私の勘違いです。
（BJ） 2019/03/12(火) 15:51

 =SUMPRODUCT(COUNTIF(A1,"*"&Sheet2!A$1:A$1600&"*")*Sheet2!B$1:B$1600)
 だったらB列に""でエラーになるが（文字列扱いのため）
 =SUMPRODUCT(COUNTIF(A1,"*"&Sheet2!A$1:A$1600&"*"),Sheet2!B$1:B$1600)
 だと""は無視される。
（ねむねむ） 2019/03/12(火) 16:23

ねむねむさま
BJさま

半角と全角のデータがあったため上手く集計できなかっただけで
=SUMPRODUCT(COUNTIF(A1,"*"&Sheet2!A$1:A$1600&"*"),Sheet2!B$1:B$1600)
この式で問題ありませんでした。。

半角全角の判別はASC関数？で出来そうな気がするのでそちらでもやってみます。
（もも） 2019/03/12(火) 16:52

追加で質問です。
一覧に存在していないものがデータシートにある時に、知らせてくれるようなマクロはありますでしょうか。
自分でも探しています。
（もも） 2019/03/13(水) 09:47

コメント返信：

[ 一覧(最新更新順) ]

[[20190311140702]] 『部分一致した場合表に出力』（もも） ページの最後に飛ぶ

[[20190311140702]]　『部分一致した場合表に出力』（もも）　ページの最後に飛ぶ