Excel (VBA) |
![]() ![]() |
(Windows 11 Pro : Excel 2021)
ロジックの考え方
投稿日時: 22/06/22 08:55:04
投稿者: Nubo
|
---|---|
シート(W1)
|
![]() |
投稿日時: 22/06/22 11:28:19
投稿者: sk
|
---|---|
引用: 本当に上記の通りでよいなら、無理に VBA を使わなくても、 ワークシート[W2]の C 列の各セルに SUMIF 関数を用いた数式を 設定すれば解決する問題でしょう。 引用: まず、ここでの文字列比較方式を明記するようにして下さい。 サンプルデータから類推した限りでは、例えば次のような 前方一致方式での文字列比較となるはず。 (ワークシート[W2]の C2 セルの数式) ------------------------------------------------------------ =SUMIF('W1'!$A$2:$A$8,A2&"_*",'W1'!$D$2:$D$8) ------------------------------------------------------------ C3:C5 にも同様の数式を設定すれば、求めている結果は得られるでしょう。 引用: (そもそもマクロを使う必要があるのか、という点は置くとして) 上記と同様の操作をマクロによって実行する形であれば、 少なくともループ処理や配列を使用する必要はありません。 |
![]() |
投稿日時: 22/06/22 13:07:38
投稿者: Nubo
|
---|---|
アドバイス感謝します。
|
![]() |
投稿日時: 22/06/22 13:50:53
投稿者: sk
|
---|---|
引用: 範囲内の全てのセルの数式をまとめて設定すれば可能です。 (標準モジュール) ------------------------------------------------------------ Sub Test1() Dim wsSource As Worksheet '参照元シートの参照 Set wsSource = ThisWorkbook.Worksheets("W1") '参照元シートのメンバーの参照、操作 With wsSource Dim lngSourceFirstRow As Long Dim lngSourceLastRow As Long '最初のデータ行の行番号を取得 lngSourceFirstRow = 2 '最後のデータ行の行番号を取得 lngSourceLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'データ行がなければ終了 If lngSourceLastRow < lngSourceFirstRow Then Set wsSource = Nothing Exit Sub End If Dim rngEvaluatedRange As Range Dim rngSumRange As Range '検索条件の評価対象となるセル範囲の参照 Set rngEvaluatedRange = .Range(.Cells(lngSourceFirstRow, "A"), _ .Cells(lngSourceLastRow, "A")) '金額の合計範囲となるセル範囲の参照 Set rngSumRange = .Range(.Cells(lngSourceFirstRow, "D"), _ .Cells(lngSourceLastRow, "D")) End With Dim wsDestination As Worksheet Set wsDestination = ThisWorkbook.Worksheets("W2") '出力先シートのメンバーの参照、操作 With wsDestination Dim lngDestinationFirstRow As Long Dim lngDestinationLastRow As Long '最初のデータ行の行番号を取得 lngDestinationFirstRow = 2 '最後のデータ行の行番号を取得 lngDestinationLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'データ行がなければ終了 If lngDestinationLastRow < lngDestinationFirstRow Then Set rngSumRange = Nothing Set rngEvaluatedRange = Nothing Set wsDestination = Nothing Set wsSource = Nothing Exit Sub End If Dim rngResultRange As Range '集計結果の出力先となるセル範囲の参照 Set rngResultRange = .Range(.Cells(lngDestinationFirstRow, "C"), _ .Cells(lngDestinationLastRow, "C")) End With 'ここから SUMIF 関数を用いた数式を生成する処理 Dim strEvaluatedRange As String Dim strCriteria As String Dim strSumRange As String Dim strFormula As String '第1引数に渡すのは、評価範囲のセル番地(絶対参照) With rngEvaluatedRange strEvaluatedRange = "'" & .Worksheet.Name & "'!" & _ .Address(RowAbsolute:=True, _ ColumnAbsolute:=True) End With '第2引数に渡すのは、「『A 列の値と "_" を連結した文字列』と '前方一致する」という検索条件(相対参照) strCriteria = "A" & lngDestinationFirstRow & "&""_*""" '第3引数に渡すのは、合計範囲のセル番地(絶対参照) With rngSumRange strSumRange = "'" & .Worksheet.Name & "'!" & _ .Address(RowAbsolute:=True, _ ColumnAbsolute:=True) End With '全ての引数を組み込んだ SUMIF 関数を用いた数式を生成 strFormula = "=SUMIF(" & strEvaluatedRange & "," & _ strCriteria & "," & _ strSumRange & ")" '生成した数式をイミディエイトウィンドウに出力する(デバッグ用) Debug.Print strFormula Application.ScreenUpdating = False '出力先セル範囲のメンバーの操作 With rngResultRange '生成した数式を全てのセルにセットする .Formula = strFormula '数式の計算結果をそのまま代入し、定数セルに変換する .Value = .Value End With Application.ScreenUpdating = True Set rngResultRange = Nothing Set rngSumRange = Nothing Set rngEvaluatedRange = Nothing Set wsDestination = Nothing Set wsSource = Nothing End Sub ------------------------------------------------------------ 引用: [W2]のデータ行の件数がそれほど多くなければ、 そういう方式でもよいと思います。 |
![]() |
投稿日時: 22/06/22 17:10:10
投稿者: Nubo
|
---|---|
skさん、ループ無しでのコード有難うございます。
|
![]() |
投稿日時: 22/06/22 18:21:48
投稿者: sk
|
---|---|
引用: ループする回数が極端に多ければ(各セルへのアクセスが 頻繁に発生すれば)、そうなる可能性は高くなるでしょうけど、 引用: ということなのであれば、今のところあまり気にすることでもないかと。 処理の目的や内容によっては、数式やワークシート関数で解決するのが困難で、 別の検索手段やループ処理、動的配列などを用いた方が適しているような ケースもあるでしょうし。 引用: あとはまあ、「処理効率の良さ」と「可読性の高さ」が両立するか、 そういうコーディングを実践できるか否かの問題。 (名前の付け方やコメントの書き方などをひっくるめての話なら 『リーダブルコード』でも読まれた方がよいと思いますが) |
![]() |
投稿日時: 22/06/23 04:54:11
投稿者: Nubo
|
---|---|
skさん、アドバイス感謝します。
|