Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

27614 / 76732

←次へ　｜　前へ→


	【54436】Re:データの抽出

VBWASURETA - 08/3/12(水) 22:48 -


	引用なし

	パスワード

一応、ポン太さんのソースからSumProduct関数で使用する
サンプルを置いておきます。

Sub main()
　　Dim ws1　　　　　　 As Worksheet
　　Dim ws2　　　　　　 As Worksheet
　　Dim DataMaxRow　　　As Long
　　Dim MstMaxRow　　　 As Long
　　Dim i　　　　　　　 As Long
　　Dim ret　　　　　　 As Long
　　Dim strSumprdct　　 As String
　　Dim strSearch　　　 As String
　　Dim strSumSearch　　As String
　　
　　Set ws1 = ThisWorkbook.Worksheets(1)　　'処理対象のシートを明確にするために変数にセット
　　Set ws2 = ThisWorkbook.Worksheets(2)
　　
　　DataMaxRow = ws1.Range("A65536").End(xlUp).Row
　　
　　'↓このｼｰﾄ2の最大行数が何故F列なのかわからないのでデータがあるE列にしました。
　　'　多分、今日も暇人さんのソースもここをE列にすると動きます。
　　MstMaxRow = ws2.Range("E65536").End(xlUp).Row

　　strSumSearch = "Apple"　'合計条件
　　
　　With ws1
　　　　For i = 7 To DataMaxRow 'ws1のA7～A最終行まで
　　　　　　'ｼｰﾄ1のA列条件
　　　　　　strSearch = ws1.Cells(i, 1).Value
　　　　　　
　　　　　　'Sumproduct関数の文字列
　　　　　　strSumprdct = "=SUMPRODUCT((" & ws2.Name & "!E1:E" & MstMaxRow & " = """ & strSearch & """)*"
　　　　　　strSumprdct = strSumprdct & "(" & ws2.Name & "!AJ1:AJ" & MstMaxRow & " = """ & strSumSearch & """)*"
　　　　　　strSumprdct = strSumprdct & "(" & ws2.Name & "!G1:G" & MstMaxRow & "))"
　　　　　　　　　　　　
　　　　　　'シート関数の実行
　　　　　　ret = Application.Evaluate(strSumprdct)
　　　　　　
　　　　　　If (ret > 0) Then
　　　　　　　　'ｼｰﾄ1のB列に結果を書く
　　　　　　　　ws1.Cells(i, 2) = ret
　　　　　　End If
　　　　Next i
　　End With
　　
　　'最後にシートオブジェクトのインスタンス解放は必ずしましょう。
　　Set ws1 = Nothing
　　Set ws2 = Nothing
End Sub

1 hits

▼

【53995】データの抽出 ポン太 08/2/19(火) 17:55