ExcelVBA シート間のコピー時に値の足し算

質問

よろしくお願いします。

Excel2003　VBAで異なるシート間でセルのコピーをしています。

ある条件の時だけコピー先のセルに値を足し込みたいのですがうまくいきません。
以下、１部抜き出しで申し訳ありませんが問題のコードを記載します。
各配列にはコピー元シートのセル列数（C_Arr）とコピー先シートのセル行数（B_Arr）・列数（A_Arr）を指定してあります。

For y = 1 To UBound(B_Arr)
For x = 1 To UBound(A_Arr)

If A_Arr(x) = 22 Then
Worksheets("A").Range(Cells(y + 2, C_Arr(x - 1)), Cells(y + 2, C_Arr(x - 1) + 1)).Copy
Worksheets("B").Cells(B_Arr(y - 1), A_Arr(x - 1)).PasteSpecial Paste:=xlValues, Operation:=xlAdd
Application.CutCopyMode = False
Else
Worksheets("A").Range(Cells(y + 2, C_Arr(x - 1)), Cells(y + 2, C_Arr(x - 1) + 1)).Copy _
Destination:=Worksheets("B").Cells(B_Arr(y - 1), A_Arr(x - 1))
End If

Next x
Next y

コードを実行するとエラーにはならないのですが、値が足し込まれず最後のコピー値が上書きされる
結果となります。

うまくいく方法を教えて下さい。

回答No.1

real beatin（@realbeatin） · ベストアンサー

こんにちは。

差し当たり、
> Worksheets("A").Range(Cells(y + 2, C_Arr(x - 1)), Cells(y + 2, C_Arr(x - 1) + 1)).Copy
この記述（２ヶ所）でのセル参照では、
　Cells(y + 2, C_Arr(x - 1))
　Cells(y + 2, C_Arr(x - 1) + 1)
の親オブジェクト（シート）指定が漏れています。
シート[A]がアクティブな場合、または、シート[A]モジュールでの記述であった場合、
にだけ正しい参照を得られる記述ですし、
そうした特定の条件が担保されているという前提だとしても、少しおかしいです。
　Range(Cells(y + 2, C_Arr(x - 1)), Cells(y + 2, C_Arr(x - 1) + 1)).Copy
で十分なケースだとすれば、Worksheets("A"). と敢えて書くこと
の意味が読む人の理解を遠ざけてしまいます。
このような特定の条件下でないのなら、
普通の標準モジュールの記述として直訳すると、
　Range(Worksheets("A").Cells(y + 2, C_Arr(x - 1)), Worksheets("A").Cells(y + 2, C_Arr(x - 1) + 1)).Copy
のように書くことになります。
この場合、シート[A]へのアクセスを繰り返していて読み難いので、簡素に意訳して
　Worksheets("A").Cells(y + 2, C_Arr(x - 1)).Resize(, 2).Copy
のような書式で参照した方が、却ってミスが少なくなると思いますが、如何でしょう。
ただ、ここで指摘したことが問題になる場合は、結果として実行時エラーに繋がりますから、
今回ご質問の主題とは直接関わりません。
けれど、やりたいことの説明を端折って、うまく動いていないコードを部分提示するのは、
読む者にとってはパズルを解くような難題になってしまいます。
題意へのこちらの理解が至っていないようであれば、すみません。

問題解決へのステップとして、
一旦、ご提示の記述を整理してみます。
' ' ///
　　For y = 1 To UBound(B_Arr)
　　　　For x = 1 To UBound(A_Arr)
　　　　　　Worksheets("A").Cells(y + 2, C_Arr(x - 1)).Resize(, 2).Copy
　　　　　　Worksheets("B").Cells(B_Arr(y - 1), A_Arr(x - 1)).PasteSpecial _
　　　　　　　　Paste:=xlValues, _
　　　　　　　　Operation:=IIf(A_Arr(x) = 22, xlPasteSpecialOperationAdd, xlPasteSpecialOperationNone)
　　　　Next x
　　Next y
　　Application.CutCopyMode = 0
' ' ///
細かい点で求める結果と異なる（書式をコピーする？処理後の選択範囲は重要？）
可能性がありますので、このスクリプトはそのまま使えるかは疑問ですが、
デバッグし易いようにという意図で書き換えたものです。

ご提示のコードから推察した前提として、
　B_Arr(0 To yy)　…　シート[A]の行位置
　A_Arr(0 To xx)　…　シート[A]の列位置
　C_Arr(0 To xx)　…　シート[B]の列位置
　何れの配列も、0 origin（最小の添え字が 0）の一次元配列、
　何れの配列も、Excelシートの[行/列]を指す整数としての要件を満たす、
　A_Arr(), C_Arr() は、同じサイズ（最大の添え字が共通）（？）の配列
　　または、C_Arr()のサイズがA_Arr()のサイズより小さいことは無い、
　A_Arr()の各要素のうち、隣り合った要素は連続数ではない（差が2以上）、
　コピー元のセル範囲は、単行２列、貼付け先も同様、
という条件で考えています。

注意して確認するべきポイントを挙げておきます。
１）カウンタのスタート値
　> For y = 1 To
　> For x = 1 To
　スタート値はそれぞれ、1、です。？
２）コピー元の行位置
　> y + 2
　y の 2 行下 です。？
３）コピー元の列位置
　> C_Arr(x - 1)
　配列C_Arr() のインデックスは x - 1 です。？
４）ペースト先の行位置
　> B_Arr(y - 1)
　配列B_Arr() のインデックスは y - 1 です。？
５）ペースト先の列位置
　> A_Arr(x - 1)
　配列A_Arr() のインデックスは x - 1 です。？
６）[値貼付け/値加算貼付け]判別の比較対象
　> A_Arr(x)
　配列A_Arr() のインデックスは x　　 です。？

現物ブックの事情や作意を知らない者として、パッと見に違和感があるのは、
　２）コピー元の行位置　だけが　配列とは無関係
　６）判別の比較対象　だけが　x　他２ヶ所では　x - 1
あたりでしょうか。
勿論、配列のサイズや中身がどんなものか知らないので、
　３）C_Arr(x - 1) ... ４） ... ５） ...
おもむろにカウンタから1引いて C_Arr(0) を参照するのも
正しいのかどうかこちらには判りませんが、
ひとつ前の数値を見る、という意味なのかな、と思っています。
他に、
　B_Arr(),A_Arr()に重複した貼付け先を参照する組合わせが在るせいで
　または、
　A_Arr()の隣り合った要素が連続数になっているせいで（単行２列に貼付けするので）
　一旦加算貼付けした部分に、重ねて（非加算）貼付けしてしまっているケース
等、
状況・条件についても確認した方が良さそうです。

> ... エラーにはならないのですが、値が足し込まれず最後のコピー値が上書きされる ...
メソッド（コピー、ペースト）部分が原因ということは考え難いので、
上記のように、
　カウンタの扱いや、各種参照、配列の要素（取得/設定の仕方）、について、
　意図した通りに書けているか
まずは確認してみて下さい。
こちらで実際にサンプルシートとサンプル配列を作ってテストした限りでは、
コードに記された命令通りに処理されることは確認できています。

> うまくいく方法を教えて下さい。
どういう結果を得られれば「うまくいった」ことになるのか、
知っているのは今の処、質問者さんだけです。
今の所の直感では、方法というより、
状況・条件と方法が噛み合っていないのかな？というのが有力と思います。
尚解決に至らない場合は、
どの場合に期待通りの結果が得られないのか、そちらでも問題の切り分けに努めて貰って
３つの配列だけでも、具体例を挙げるなど、補足してみて下さい。

以上です。

お礼

realbeatinさま

回答ありがとうございました。

ご指摘頂いた違和感の部分　６）が原因でした。

解決に至りましたのでお礼させて頂きます。

＞やりたいことの説明を端折って、うまく動いていないコードを部分提示するのは、読む者にとってはパズルを解くような難題になってしまいます。

すいませんでした。以後気をつけます。
蛇足になってしまいそうですが、以下にご指摘の部分も含めたコードを再掲します。コピー元シートの行位置は１行ずつ下がっていけば良いため配列に規定しませんでした。また、似たようなシートが何枚かあり、それぞれ行数・列数がバラバラのためこのようなコードにしました。

Private Sub シート間コピー()

Dim A_Arr As Variant 'シートＡの列位置
Dim B_Arr As Variant 'シートＡの行位置
Dim C_Arr As Variant 'シートＢの列位置
Dim x, y

A_Arr = Array(2, 4, 6, 8, 10, 16, 12, 14, 18, 22, 22, 26, 29)
C_Arr = Array(3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25, 27)

B_Arr = Array(4, 6, 8, 10, 12, 14, 16, 18, 20, 22, _
24, 26, 28, 30, 32, 34, 36, 38, 40, 42, _
44, 46, 48, 50, 52, 54, 56, 58, 60, 62, _
66, 68, 68, 70, 72, 74, 78, 82, 84, 80, _
86, 88, 90, 92, 94, 96, 98, 100, 102, 104, 106)

Sheets("A").Select

For y = 1 To UBound(B_Arr)
For x = 1 To UBound(A_Arr)

If A_Arr(x) = 22 Then
Worksheets("A").Range(Cells(y + 2, C_Arr(x - 1)), Cells(y + 2, C_Arr(x - 1) + 1)).Copy
Worksheets("B").Cells(B_Arr(y - 1), A_Arr(x - 1)).PasteSpecial Paste:=xlValues, Operation:=xlAdd
Application.CutCopyMode = False
Else
Worksheets("A").Range(Cells(y + 2, C_Arr(x - 1)), Cells(y + 2, C_Arr(x - 1) + 1)).Copy _
Destination:=Worksheets("B").Cells(B_Arr(y - 1), A_Arr(x - 1))
End If

Next x
Next y

End Sub

ーーー
if A_Arr(x-1) = 22　に修正したところ望み通りの結果が得られました。

ResizeプロパティやIIf関数などスマートなテクニックをご紹介頂きありがとうございました。疑問点として挙げて頂いたカウンタが１から始まる記述も必要ありませんので、そのあたりも取り入れてコードを書き直してみます。

realbeatinさま、本当に助かりました。
ありがとうございました。