Excel関数 条件に一致する行 データの種類

質問

エクセルの関数に関して質問です。エクセル２００３を使用しています。

A列の値が一致する行に対し、B列のデータの種類を数えたいのですが
Excel関数で実現できますか？

No　 A列 B列　　　求める結果
1 　中国語 Chaina　　　　1
2 　中国語 Chaina　　　　1
3 　日本語 Japan　　　　 2
4 　日本語 America　　　2
5 　日本語 Japan　　　　 2

どうぞ知恵をお貸しください。よろしくお願いします。

回答No.1

tom04 · ベストアンサー

こんばんは！
関数での方法をご希望だというコトですので、
一例です。

↓の画像で説明します。
作業用の列を2列設けています。

作業列1のD2セルに
=IF(COUNTBLANK(B2:C2),"",B2&"_"&C2)

作業列2のE2セルに
=IF(OR(D2="",COUNTIF(D$2:D2,D2)>1),"",1)

という数式を入れ、両列ともオートフィルでずぃ～～～！っとしっかり下へコピーしておきます。

最後に結果のG2セルに
=IF(D2="","",SUMIF(B:B,B2,E:E))
という数式を入れオートフィルで下へコピー！
これで画像のような感じになります。

※　作業列が目障りであれば遠く離れた列に設けるか、
作業列を非表示にしてください。m(_ _)m

お礼

すごいです！実現できました！
迅速に分かりやすくご回答頂き、大変ありがとうございました。

補足

エクセルの関数で実装したところ、処理が重くなってしまい、VBAでの実装を検討しています。
実装案をぜひお聞かせください。

回答No.2

tom04

No.1です！
補足の
＞処理が重くなってしまい、

すなわち、かなりのデータ量がある！というコトですね？
となると、For～Next　でループさせたり、前回の関数の方法をマクロでやったとしても
おそらくExcelが「応答なし」になってしまうと思いますので、
オートフィルタの方法でやってみました。

尚、元データがSheet1にあり、結果をD列に表示させるとします。
そして、Sheet2を作業用のSheetとして使用していますので、
Sheet2は全く使用していない状態でマクロを試してみてください。
今回もSheet1のA2以降にデータがあるとします。
（Sheet1の1行目の項目はA～D列まで入れておいてください。）

標準モジュールです。

Sub Sample1()
Dim i As Long, endRow1 As Long, endRow2 As Long, wS1 As Worksheet, ws2 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Application.ScreenUpdating = False
endRow1 = wS1.Cells(Rows.Count, "B").End(xlUp).Row
wS1.Range("E:E").Insert '←E列以降使用していない場合は不要
wS1.Range("E1") = "ダミー"
Range(wS1.Cells(2, "E"), wS1.Cells(endRow1, "E")).Formula = "=B2 & ""_"" & C2"
Range(wS1.Cells(1, "E"), wS1.Cells(endRow1, "E")).AdvancedFilter Action:=xlFilterInPlace, unique:=True
wS1.Range("E:E").Copy ws2.Range("A1")
wS1.ShowAllData
endRow2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
Range(ws2.Cells(2, "B"), ws2.Cells(endRow2, "B")).Formula = "=LEFT(A2,FIND(""_"",A2)-1)"
Range(ws2.Cells(2, "C"), ws2.Cells(endRow2, "C")).Formula = "=COUNTIF(B:B,B2)"
For i = 2 To endRow2
wS1.Range("A1").AutoFilter field:=5, Criteria1:=ws2.Cells(i, "A")
Range(wS1.Cells(2, "D"), wS1.Cells(endRow1, "D")).SpecialCells(xlCellTypeVisible) = ws2.Cells(i, "C")
Next i
wS1.AutoFilterMode = False
wS1.Range("E:E").Delete
ws2.Cells.Clear
Application.ScreenUpdating = True
MsgBox "処理完了"
End Sub

こんな感じではどうでしょうか？m(_ _)m

お礼

アイディアとても参考になります。大変感謝しています。
ご丁寧に回答頂きありがとうございました。