Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 10 Home : Excel 2013)
エクセルマクロでSUMPRODUCTとCOUNTIFSの組合せ
投稿日時: 18/09/13 15:14:46
投稿者: kitami

初めて投函します
エクセルマクロでSUMPRODUCTとCOUNTIFSの組合せのコードを教えてください。
A5:A300 日付
B5:B00 取引先名
同じ日付で取引先は重複します。
宜しくお願いします。

回答
投稿日時: 18/09/13 15:23:15
投稿者: WinArrow
投稿者のウェブサイトに移動

結果として、何を求めたいのですか?
 
「日付&取引先」の件数ですか?

投稿日時: 18/09/13 15:53:08
投稿者: kitami

WinArrow様
早速ありがとうございます。
C社が何回かです。
 例
 日付 取引先名
9/1  C社
9/1  C社
9/1  D社
9/2  C社
9/2  E社
9/3  C社
 答え C社は3日(3回)出てくる。

回答
投稿日時: 18/09/13 17:05:22
投稿者: WinArrow
投稿者のウェブサイトに移動

多分、SUMPRODUCT COUNTIFSでは、難しいと思います。
 
 
マクロかする前に手作業で実行してみましょう。
 
 
フィルタオプションを使用します。
 
例として掲示の表がA列,B列として
 
D、Eに抽出用データ表を作成します。
セルD1:日付
セルE1:取引先名
セルE2:C社
 
元表にカーソルを置いて
「データ」タブの「詳細設定」をクリックします。
「抽出先」:「指定した範囲」を選択
「リスト範囲」:$A$1:$B$7
「検索条件範囲」:$D$1:$E$2
「抽出範囲」:$G$1;$H$1
「重複したレコードは無視する」にチェックを入れる
「OK」
 
この操作で、日付&取引先が重複無視の3件抽出されます。
抽出結果をCOUNTIF関数で件数が取得できます。
 
 
 

投稿日時: 18/09/13 17:38:09
投稿者: kitami

すべてをマクロで実行が希望です。
関数だけ件数は検索できます。
例 シート「データ」にデータがあります。
=SUMPRODUCT((データ!$B$5:$B$59568="C社")/COUNTIFS(データ!$B$5:$B$59568,データ!$B$5:$B$59568&"",データ!$A$5:$A$59568,データ!$A$5:$A$59568&""))
蒸気を参考にマクロで値だけを求めています。

回答
投稿日時: 18/09/13 18:10:46
投稿者: WinArrow
投稿者のウェブサイトに移動

dim Shiki As string
Shiki = "SUMPRODUCT((データ!$B$5:$B$59568=""C社"")/COUNTIFS(データ!$B$5:$B$59568,データ!$B$5:$B$59568&"""",データ!$A$5:$A$59568,データ!$A$5:$A$59568&""""))"
 
Debug.Print Application.Evaluate(Shiki)
 
※この関数って、データ件数が多くて時間かかりませんか?

投稿日時: 18/09/13 18:37:02
投稿者: kitami

更新に時間がかかるのでマクロ処理を希望しています。

回答
投稿日時: 18/09/13 20:19:18
投稿者: WinArrow
投稿者のウェブサイトに移動

↓のコードを実行してみてください。
Option Explicit
 
Sub Macro1()
Dim 開始 As Single
'
    開始 = Timer
    With ActiveSheet
        .Range("A1:B1").Copy Destination:=.Range("D1:E1")
        .Range("E2").Value = "C社": .Columns("G:H").Cells.ClearContents
        .Range("A1:B" & .Cells(.Rows.Count, "A").End(xlUp).Row).AdvancedFilter _
            Action:=xlFilterCopy, _
            CriteriaRange:=.Range("D1:E2"), _
            CopyToRange:=Range("G1"), _
            Unique:=True
        Debug.Print .Range("G1").End(xlDown).Row - 1 & "件"
        .Range("D1:E2").ClearContents
        .Columns("G:H").Cells.ClearContents
    End With
    Debug.Print Round(Timer - 開始, 1) & "秒です。"
End Sub

投稿日時: 18/09/13 21:49:54
投稿者: kitami

希望通りに完成しました。
ありがとうございます。

トピックに返信