質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

1回答

430閲覧

VBAロジックについての質問

King_of_Flies

総合スコア382

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2022/09/29 01:22

前提

実装案が全く思い浮かばないため、
先人の知恵を拝借したいです。

実現したいこと

Excelに3シート
「A」「B」「AB合算※Cシートと呼称します」というシートがあります。

それぞれ
「A」「B」「C」は共通のヘッダで
コード,金額を持っています。

例えばAシートには
01,1000
02,2000
03,3000
05,5000

Bシートには
01,1500
02,2500
04,4500

とあるとしたら、
VBAの実装でCシートにコードの昇順
01,2500 'AシートとBシートの金額合算値(コードごと)
02,4500 'AシートとBシートの金額合算値(コードごと)
03,3000 'Aシートにあるが、BシートにはないデータはAシートのデータだけ
04,4500 'Bシートにあるが、AシートにはないデータはBシートのデータだけ
05,5000 'Aシートにあるが、BシートにはないデータはAシートのデータだけ

と出力されるようにしたいのです。

該当のソースコード

現在実装で考え付いているところまでで

sheetADataCnt = 4
sheetBDataCnt = 3
MaxCnt = sheetADataCnt + sheetBDataCnt

VBA

1For h = 1 To MaxCnt 2 For i = 1 To sheetADataCnt 3 For j = 1 To sheetBDataCnt 4 'AコードとBコードの突合せ 5 If SheetA.Cells(i,1).Value = SheetB.Cells(j,1).Value Then 6 'コード転記 7 SheetC.Cells(h ,1).Value = SheetA.Cells(i,1).Value 8       '金額転記 9 SheetC.Cells(h ,2).Value = SheetA.Cells(i,2).Value + SheetB.Cells(j,2).Value 10 End If 11 Next 12 Next 13Next

と上記のようにしています。

ただ、このやり方だと
Cシートには
01,2500
02,4500
しか出力されません。

これは当たり前ですが、If条件を満たしたときだけCシートに書き写す処理になっているので
ここからIFの条件文を追加してAシートのみのデータ、BシートのみのデータをCシートに反映したいのでが、実装案が浮かびません。

Cシートに反映させるときにコードの昇順になっている必要があるところが
悩ませている原因であり、上手い打開案がないでしょうか。

よろしくお願いします。

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

sazi

2022/09/29 02:17

Power Queryを使ってみては。
guest

回答1

0

ベストアンサー

いろいろな方法があると思いますが、 連想配列(Dictionaryオブジェクト)を使ったコード例。

vba

1Public Sub Sample() 2 'シートA シートBのデータ範囲の取得 3 Dim rngA As Range, rngB As Range 4 Set rngA = Worksheets("A").Cells(1).CurrentRegion.Offset(1) 5 Set rngA = rngA.Resize(rngA.Rows.Count - 1) 6 Set rngB = Worksheets("B").Cells(1).CurrentRegion.Offset(1) 7 Set rngB = rngB.Resize(rngB.Rows.Count - 1) 8 9 Dim D As Object 10 Set D = CreateObject("Scripting.Dictionary") 11 12 'シートAのA列をキー、B列をアイテムとしてDictionaryに登録。 13 Dim r As Range 14 For Each r In rngA.Rows 15 D(r.Cells(1, 1).Text) = r.Cells(1, 2).Value 16 Next 17 18 'シートBのA列をキー、B列をアイテムとしてDictionaryに登録。同じキーのアイテムは加算。 19 For Each r In rngB.Rows 20 D(r.Cells(1, 1).Text) = D(r.Cells(1, 1).Text) + r.Cells(1, 2).Value 21 Next 22 23 With Worksheets("C") 24 .Range("A1:B1").Value = Worksheets("A").Range("A1:B1").Value '項目行転記 25 'Dictionaryのキー配列をシートCに出力 26 .Range("A2").Resize(D.Count).Value = WorksheetFunction.Transpose(D.keys) 27 'Dictionaryのアイテム配列(集計値)をシートCに出力 28 .Range("B2").Resize(D.Count).Value = WorksheetFunction.Transpose(D.Items) 29 End With 30End Sub

連想配列はちょっと難しいですが、いろいろな場面で使えるので、習得しておくといいでしょう。

投稿2022/09/29 04:19

hatena19

総合スコア33620

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

King_of_Flies

2022/09/29 04:30

まず定数定義のところで使用しているCurrentRegion.Offset(1)を初知でした。 いつもDim sheetHeadderRow = 1 的な感じで宣言して、 Cellsの指定値に-sheetHeadderRow とかして行数取得してたので、ほえぇと感激しました。 また Dim r As Range For Each r In rngA.Rows D(r.Cells(1, 1).Text) = r.Cells(1, 2).Value Next この部分のロジックですが、キーを二つ以上持たせることもできそうなので、 戦略幅が広がりそうです。 ありがとうございました。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問