Excel2007で複雑なセルコピペ。続きです

質問

＞＞「インデックス有効範囲エラー」がでました。

申し訳ありませんが
・[SetData]モジュールで変更した箇所とその値
・エラーが起こった時のi、j、kの値
を教えてください。

i、j、kは、エラーでストップした際、それぞれの変数の上にマウスカーソルを動かせば表示される筈です。
或いは右クリック-[ウォッチ式の追加]で、ウォッチウィンドウに表示させる方法もあります。
※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※
＞・エラーが起こった時のi、j、kの値
を教えてください。

i,j,kの値は1でした。

＞・[SetData]モジュールで変更した箇所とその値
リボルビングセル範囲のコピペがしたかったので、こちらを選びました。
Set rangeCompare = myWS.Range("D63:D10000")
Rev.OffRow = Array(-55, -57)
Rev.OffCol = Array(0, 0)
Rev.ResRow = 51
Rev.ResCol = 1
Set rangeResult = myWS.Range("N4")
numResult = 2

どうなんでしょうか？長らく時間をとらせて頂いて感謝します。

回答No.12

Mathmi · ベストアンサー

値の比較と背景の着色をサブルーチン化したバージョンのコードも作ってみました。
[CheckSameValue]モジュールに、引数として比較元、比較先、着色する色を指定すれば、比較元と同じ値のセルに着色します。

Sub CompareMain(ByRef rangeCompare As Range, ByRef rev As Revolving, ByRef aryCompare As Variant, ByRef rangeResult As Range, ByRef numResult As Integer, ByRef aryResult As Variant, ByRef clrCompare As Long)
　Dim i As Long, j As Integer, k As Integer, cnt As Integer
　Dim numRow As Integer, numCol As Integer '比較元セル範囲の左上の行番号、列番号。
　Dim numRev As Integer '使用するリボルビング配列の番号。

　'比較する値を、出力する並びでaryResultに格納。
　numRow = rangeCompare(1).Row
　numCol = rangeCompare(1).Column
　For i = 1 To rangeCompare.Rows.Count
　　aryResult(i, 1) = aryCompare(numRow + i - 1, numCol) '比較元の値をコピー
　　cnt = numResult '結果の比較先の出力列番号。
　　numRev = (i - 1) Mod (UBound(rev.OffRow) + 1)
　　For j = 1 To rev.ResRow
　　　For k = 1 To rev.ResCol
　　　　aryResult(i, cnt) = aryCompare(numRow + i - 1 + rev.OffRow(numRev) + j - 1, numCol + rev.OffCol(numRev) + k - 1)
　　　cnt = cnt + 1
　　　Next k
　　Next j
　Next i

　'更新停止
　Application.EnableEvents = False
　Application.ScreenUpdating = False
　Application.Calculation = False
　'セルに出力、着色。
　rangeResult = aryResult 'セルに出力
　For i = 1 To rangeResult.Rows.Count
　　Call CheckSameValue(rangeResult(i, 1), Range(rangeResult(i, numResult), rangeResult(i, rangeResult.Columns.Count)), clrCompare)
　Next i
'更新再開
　Application.EnableEvents = True
　Application.ScreenUpdating = True
　Application.Calculation = True
End Sub

Sub CheckSameValue(ByRef BaseCell As Range, ByRef CheckRange As Range, ByRef clrCompare As Long)
'CheckRange内にBaseCellと同じ値があった場合、そのセルとbaseCellの背景色をclrCompareとする。
　Dim myCell As Range

　For Each myCell In CheckRange
　　If BaseCell.Value = myCell.Value Then
　　　BaseCell.Interior.Color = clrCompare
　　　myCell.Interior.Color = clrCompare
　　End If
　Next myCell
End Sub

お礼

ありがとうございました！

回答No.11

Mathmi

[CompareMain]モジュールを以下のものに差し替えてみて下さい。
「'着色するセル位置を検索」以降を変更し、一旦blnPaintに着色の有無を格納するのを止めてみました。
これでどうでしょうか？

Sub CompareMain(ByRef rangeCompare As Range, ByRef rev As Revolving, ByRef aryCompare As Variant, ByRef rangeResult As Range, ByRef numResult As Integer, ByRef aryResult As Variant, ByRef clrCompare As Long)
　Dim i As Long, j As Integer, k As Integer, cnt As Integer
　Dim numRow As Integer, numCol As Integer '比較元セル範囲の左上の行番号、列番号。
　Dim numRev As Integer '使用するリボルビング配列の番号。

　'比較する値を、出力する並びでaryResultに格納。
　numRow = rangeCompare(1).Row
　numCol = rangeCompare(1).Column
　For i = 1 To rangeCompare.Rows.Count
　　aryResult(i, 1) = aryCompare(numRow + i - 1, numCol) '比較元の値をコピー
　　cnt = numResult '結果の比較先の出力列番号。
　　numRev = (i - 1) Mod (UBound(rev.OffRow) + 1)
　　For j = 1 To rev.ResRow
　　　For k = 1 To rev.ResCol
　　　　aryResult(i, cnt) = aryCompare(numRow + i - 1 + rev.OffRow(numRev) + j - 1, numCol + rev.OffCol(numRev) + k - 1)
　　　　cnt = cnt + 1
　　　Next k
　　Next j
　Next i

　'更新停止
　Application.EnableEvents = False
　Application.ScreenUpdating = False
　Application.Calculation = False
　'セルに出力、着色。
　rangeResult = aryResult 'セルに出力
　For i = 1 To rangeResult.Rows.Count
　　For j = numResult To rangeResult.Columns.Count
　　　If aryResult(i, 1) = aryResult(i, j) Then
　　　　rangeResult(i, 1).Interior.Color = clrCompare
　　　　rangeResult(i, j).Interior.Color = clrCompare
　　　Else
　　　　rangeResult(i, j).Interior.ColorIndex = xlColorIndexNone
　　　End If
　　Next j
　Next i
　'更新再開
　Application.EnableEvents = True
　Application.ScreenUpdating = True
　Application.Calculation = True
End Sub

お礼

こんばんはmathmi さん。出来ました！！！
無茶苦茶嬉しいです。でも完璧に私自身は追い付けてないんです。それは当然で経験がまだまだ初期段階なんで_(^^;)ゞ
私の質問はもうmathmi さんしか分かってもらえない気がするくらいあなたを尊敬します。(^-^)ゝ゛
またこの続きがあるんで、似たような感じの質問を指名でさせてください。
この度は誠に感謝します。ありがとうございました。

回答No.10

Mathmi

＞M列のセル値と水平上にある同値の全てのセルの背景色染めの方法
今までの要望通り、No.5の添付画像のように着色したい、という事ですよね。
No.3にある今までのコードを使えば要望通りの結果になる筈で、自分の方で試した結果要望通りの結果が出ているんです。
バグの再現ができないので、デバッグが行き詰っているのが現状です。

背景色を着色するルーチンを、一回作り直して見ます。

1:使用しているソフトは、純正officeのexcelですよね？　open officeやLibra officeではありませんよね？

2:新規ブックに、自分の作ったコードと比較するD列の値だけ入れても、同じ様に全ての出力範囲の背景色が着色されますか？

お礼

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

回答No.9

Mathmi

＞変化無しでやはりベターっと黄色のまんまです。
　駄目でしたか。申し訳ありません。

＞一度にすると難しいんですかね？
いえ、それほど難しくはない筈です。実際、自分のパソコンで実行した場合にはきちんと実行されるので。

そうなると、済みません。現状エラーの原因が分かりません。
（No6の2:でMN列も着色されなかったり、1:でstopに行けるのに着色されたりと、コード上あり得ない筈なのですが）

最終手段ですが、そのエラーが発生しているエクセルファイルを送って貰う事はできませんでしょうか？
エラーが再現できれば、他の部分は不要ですので。
（極端な話、D列に入れたランダムな値と、問題のコードだけのファイルでも、同様のエラーが発生するなら問題ありません）
firestorageのようなファイル転送サービスを使うか、捨てアド同士でファイルを受け渡す事になるかと思いますが、ご一考お願いしたく思います。

お礼

mathmi さん、ご助力ありがとうございます。

リボルビングでの範囲の横化O列からのコピペは成功したので
M列のセル値と水平上にある同値の全てのセルの背景色染めの方法を教えて欲しいです。

回答No.8

Mathmi

色々と確認して頂き、ありがとうございます。

どうも、boolean型の変数であるblnPaintの初期値が、FalseではなくTrueになっているようです。
「'着色するセル位置を検索」ブロック、[ReDim blnPaint(1 To rangeResult.Rows.Count, 1 To rangeResult.Columns.Count)]の下側に、以下の5行を追加してください。

　For i = 1 To rangeResult.Rows.Count
　　For j = 1 To rangeResult.Columns.Count
　　　blnPaint(i, j) = False
　　Next j
　Next i

これで、想定通りの動きをする筈です。

お礼

こんにちはmathmi さん。してみましたが、変化無しでやはりベターっと黄色のまんまです。

一度にすると難しいんですかね？

分けてマクロの記録でする 形にして頂けたらと…。
でもここまできて後ちょっとで出来そうな予感もしますしね。

どっちにしても私１人じゃとてもできません。Excelってできると便利ですね。

回答No.7

Mathmi

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

どうも、「'セルに出力、着色。」ブロックのIf～Thenが上手く働いていないか、blnPaintの初期値がtrueになっているっぽいのですが……。
一回、以下の変更を別々に試してみて下さい。
（これは、問題点を見つける為の変更なので、本来のコードを変更するものではありません）

1:「'セルに出力、着色。」ブロック
[rangeResult(i, j).Interior.Color = clrCompare]と[End If]の間に
　　　Else
　　　　Stop
の2行を追加して、[stop]で止まるか試してみて下さい。

2:「'着色するセル位置を検索」ブロック
[blnPaint(i, j) = True]と[End If]の間に
　　　Else
　　　　blnPaint(i, j) = False
の2行を追加してみて下さい。
上手く行けば、O列以降で重複しないセルは着色されなくなる筈です(M列N列はまだ全着色)。

3:「'セルに出力、着色。」ブロック
[rangeResult = aryResult]と[For i = 1 To rangeResult.Rows.Count]の間に[Exit Sub]を追加してみて下さい。
想定では、値だけが出力されてセルの背景色は変わらないはずなのですが、マクロ実行前から変わっていますか？

4:他のマクロがないか確認。
特にシートモジュール（Microsoft Excel Objectsの下の、Sheet1(Sheet1)とかの名前のモジュール）に設定されていませんか？
あれば、そのプロシージャ名(Sub *** ()の***の部分)を教えてください。

5:出力先に条件付き書式が設定されていないか確認。
比較する値がD5000までしかないのに、9941まで着色されているという事は、この問題ではないと思いますが、一応確認お願いします。

お礼

＞1:「'セルに出力、着色。」ブロック
[rangeResult(i, j).Interior.Color = clrCompare]と[End If]の間に
　　　Else
　　　　Stop
の2行を追加して、[stop]で止まるか試してみて下さい。
334 行目まで黄色にそまり、ソースのstop が黄色になりました。

＞2:「'着色するセル位置を検索」ブロック
[blnPaint(i, j) = True]と[End If]の間に
　　　Else
　　　　blnPaint(i, j) = False
の2行を追加してみて下さい。
上手く行けば、O列以降で重複しないセルは着色されなくなる筈です(M列N列はまだ全着色)。

MN 列含めた重複しない行だけが無色でした。

＞3:「'セルに出力、着色。」ブロック
[rangeResult = aryResult]と[For i = 1 To rangeResult.Rows.Count]の間に[Exit Sub]を追加してみて下さい。
想定では、値だけが出力されてセルの背景色は変わらないはずなのですが、マクロ実行前から変わっていますか？

仰る通り値だけでした。無色でした。

＞4:他のマクロがないか確認。
特にシートモジュール（Microsoft Excel Objectsの下の、Sheet1(Sheet1)とかの名前のモジュール）に設定されていませんか？
あれば、そのプロシージャ名(Sub *** ()の***の部分)を教えてください。

sheetモジュールには無いです。

＞5:出力先に条件付き書式が設定されていないか確認。
比較する値がD5000までしかないのに、9941まで着色されているという事は、この問題ではないと思いますが、一応確認お願いします。

確認の仕方が下手なんで教えて頂けませんか？
多分無いとは思いますが

回答No.6

Mathmi

＞No 3のソースをM4の件以外はストレートに写しました。
回答ありがとうございます。

何の変更もせず、ただコピーしたコードを実行して
＞全セルの背景色が黄色くなってしまってました
となったんですか。
すみません。ちょっと想定外でした。

とりあえず、基本中の基本から確認していきます。当然だと思われるような項目もありますが、確認ですのでご容赦を。

1:D7:D10000には値が入っていますか？
2:出力先(M列やO列以降)には、想定した値が出力されていますか(M4にはD63の、O4にはD8の値等)？
3:着色された部分には、異なる値が出力されていますか(M4とO4は別の値なのに、両方着色されている等)？
4:空白であるべきN列にも着色されていますか？
5:N列に値は出力されていませんか？
6:範囲外の行(1:3行や9943行以降)は着色されていませんか？
7:マクロを実行する前、出力する予定の範囲(M列以降)の背景色に何も設定されていませんか（無色ですか）？
8:実行するマクロは間違いありませんか（シートのボタンにマクロを紐づけていたりして、新しいマクロに紐づけを更新してなかったりなど）？
9:出力先セル(M列以降)が結合されてはいませんか？

一応、「'着色するセル位置を検索」ブロックのIf～Then行とEnd If行をコメントアウトした場合、N列以外の出力セル全てに着色されました（添付画像参照）。
「'セルに出力、着色。」ブロックの場合は、N列にも着色されました。

お礼

＞1:D7:D10000には値が入っていますか？
途中(5000行目)しか入ってないです。なので×

＞2:出力先(M列やO列以降)には、想定した値が出力されていますか(M4にはD63の、O4にはD8の値等)？
大丈夫です。○
＞3:着色された部分には、異なる値が出力されていますか(M4とO4は別の値なのに、両方着色されている等)？
M4 からEM9941までびっしりと黄色くなってます。なので×

＞4:空白であるべきN列にも着色されていますか？
ハイ
＞5:N列に値は出力されていませんか？
出力無しです。
＞6:範囲外の行(1:3行や9943行以降)は着色されていませんか？
9941まで着色ありで升目がなくなってます。

7:マクロを実行する前、出力する予定の範囲(M列以降)の背景色に何も設定されていませんか（無色ですか）？
C列～I列に着色ありです。
8:実行するマクロは間違いありませんか（シートのボタンにマクロを紐づけていたりして、新しいマクロに紐づけを更新してなかったりなど）？
ここは理解が難しいです。(マクロに紐付けと言う表現がわからないです。)
9:出力先セル(M列以降)が結合されてはいませんか？
結合セルはないです。

回答No.5

Mathmi

＞M4 の値が3ならO4から横に50セル範囲の内に同じ値3のセル背景の色を色付けしたいと言う意味でした。
あ、判定方法は変わっていなかったのですね。申し訳ありません。
こちらで使用した場合同じ値の場所にしか着色されていない事と、改めて書かれている事から、判別条件が変わったものと勘違いしてしまいました。

＞全セルの背景色が黄色く
aryResultに代入する値がおかしいのか、「'着色するセル位置を検索」ブロックの条件式がおかしいのか、「'セルに出力、着色。」ブロックの条件式がおかしいのか。
現状では、エラーの原因が特定できません。
使用しているコードをアップできますか？　或いは、どこをどのように変更したのかを教えて下さい。

参考までに、こちらで実行した結果の一部の画像を添付します。実際には、画面の右側(V列以降)や下側(22行以降)にも出力した値は続いています。
M18/M20の背景色が黄色でないのは、右側の画像外の範囲にも一致する値がないからです。

お礼

返答ありがとうございますmathmi さん。No 3のソースをM4の件以外はストレートに写しました。それだけなんです。

回答No.4

Mathmi

＞M4の隣のN列は空けておいてO4から
[Set rangeResult = myWS.Range("N4")]のN4をM4に、[numResult=2]の値を2から3に変更します。
これで、M4を1列目とした3列目、即ちO4から右に比較対象がペーストされます。

＞全セルの背景色が黄色くなってしまってました
出力するセルが全て着色されたのだとすると、まず考えられるのは、変数blnPaintの中が全てtrueになっている事です。
この変数の値を変えるのは[CompareMain]プロシージャの「'着色するセル位置を検索」ブロックのみなので、問題があるならここのIf～Thenの条件式でしょうか。

＞M列の１つ１つのセルの値に、その１つ１つの行上に等しい値の背景色を色付けするのが目的でもあります。
すみません。どのような操作を行いたいのかが理解できません。
M[n+1]のセルの値とM[n]の値を比較し、同じ値の場合は、M[n]の背景色をM[n+1]のセルに色付けするんでしょうか？　そうすると、最初の4行目の時の処理が変な事になるし、O[n]～BM[n]との比較の仕方も変わってくるから、違う気がしますが。

何度も言いますが、要望は具体的にお願いします。
機能の追加・変更なら、実際にどのような操作を行いたいのかの具体例を上げて下さい。
（というか「手作業ならどのような操作をするのか」を考えるのは、エクセルマクロを作る時の基本です）
エラーが起こったなら、どこをどう変更したらどこでエラーが起こったを明確にして下さい。
いっそ全文上げて貰った方が、デバッグはやりやすいくらいです。

お礼

＞M列の１つ１つのセルの値に、その１つ１つの行上に等しい値の背景色を色付けするのが目的でもあります。

分かりにくい説明でした。
M4 の値が3ならO4から横に50セル範囲の内に同じ値3のセル背景の色を色付けしたいと言う意味でした。
M6の値が7ならO6から横になってる50セル範囲の内に同じ値7のセル背景の色を色付けする。
という形にしたかったんです。

回答No.3

Mathmi

＞一度ストレートにソースを書いて頂きたいのです。
前回のNo18,19及び今回の「Set rangeCompare = myWS.Range("D63:D10000")～」を元にしたコードです。
こちらで実行してみた所、エラーは起こっていません。

Option Explicit

Type Revolving
　OffRow As Variant 'Offset Row。基準セルから比較先セルへの相対行数。
　OffCol As Variant 'Offset Column。基準セルから比較先セルへの相対列数。
　ResRow As Integer 'Resize Row。比較先セル範囲の行数。
　ResCol As Integer 'Resize Column。比較先セル範囲の列数。
　v As Variant
End Type

Sub SetData()
'作業対象範囲等を設定するプロシージャ
　Dim temp As Variant
　Dim myWS As Worksheet '作業を行うワークシート。
　Dim rangeCompare As Range '比較元セル範囲。
　Dim rev As Revolving 'リボルビング相対位置。
　Dim numCompare As Integer '比較先セル範囲個数。
　Dim aryCompare As Variant '比較するセル範囲の値。
　Dim rangeResult As Range '出力先セル範囲
　Dim numResult As Integer '結果を出力する際、比較先を比較元の何列隣から出力するか。0なら同じ列。
　Dim aryResult As Variant '結果の値を格納する配列。
　Dim clrCompare As Long '値が同じだった場合に着色する色

　'作業を行うワークシートを設定
　Set myWS = ActiveSheet

　'比較元セル範囲を設定
　Set rangeCompare = myWS.Range("D63:D10000")

　'リボルビング相対位置を設定
　rev.OffRow = Array(-55, -57)
　rev.OffCol = Array(0, 0)
　rev.ResRow = 51
　rev.ResCol = 1
　numCompare = rev.ResRow * rev.ResCol

　'エラーチェック
　If rangeCompare.Columns.Count > 1 Then
　　MsgBox ("比較元が2列以上に設定されています。")
　　Exit Sub
　End If
　If UBound(rev.OffRow) <> UBound(rev.OffCol) Then
　　MsgBox ("リボルビング配列の行数と列数が異なっています。")
　　Exit Sub
　End If
　If rangeCompare(1).Row + WorksheetFunction.Min(rev.OffRow) <= 0 Or _
　 rangeCompare(1).Column + WorksheetFunction.Min(rev.OffCol) <= 0 Then
　　MsgBox ("シート範囲外と比較しようとしています。")
　　Exit Sub
　End If
　If rev.ResRow <= 0 Or rev.ResCol <= 0 Then
　　MsgBox ("比較先行数もしくは列数が0以下です。")
　　Exit Sub
　End If

　'比較セル範囲の値を取得
　Set temp = rangeCompare(rangeCompare.Count)
　Set temp = temp.Offset(WorksheetFunction.Max(0, WorksheetFunction.Max(rev.OffRow) + rev.ResRow - 1), 0)
　Set temp = temp.Offset(0, WorksheetFunction.Max(0, WorksheetFunction.Max(rev.OffCol) + rev.ResCol - 1))
　aryCompare = myWS.Range("A1", temp).Value

　'出力先セル範囲を設定。
　Set rangeResult = myWS.Range("N4") '結果基準セルを設定
　numResult = 2
　Set rangeResult = rangeResult.Resize(rangeCompare.Rows.Count, numResult + numCompare - 1)
　ReDim aryResult(1 To rangeResult.Rows.Count, 1 To rangeResult.Columns.Count)

　'着色する色を設定
　clrCompare = RGB(255, 255, 153)

　Call CompareMain(rangeCompare, rev, aryCompare, rangeResult, numResult, aryResult, clrCompare)
End Sub

Sub CompareMain(ByRef rangeCompare As Range, ByRef rev As Revolving, ByRef aryCompare As Variant, ByRef rangeResult As Range, ByRef numResult As Integer, ByRef aryResult As Variant, ByRef clrCompare As Long)
　Dim i As Long, j As Integer, k As Integer, cnt As Integer
　Dim numRow As Integer, numCol As Integer '比較元セル範囲の左上の行番号、列番号。
　Dim numRev As Integer '使用するリボルビング配列の番号。
　Dim blnPaint() As Boolean 'そのセル位置を着色するか。Trueなら着色する。

　'比較する値を、出力する並びでaryResultに格納。
　numRow = rangeCompare(1).Row
　numCol = rangeCompare(1).Column
　For i = 1 To rangeCompare.Rows.Count
　　aryResult(i, 1) = aryCompare(numRow + i - 1, numCol) '比較元の値をコピー
　　cnt = numResult '結果の比較先の出力列番号。
　　numRev = (i - 1) Mod (UBound(rev.OffRow) + 1)
　　For j = 1 To rev.ResRow
　　　For k = 1 To rev.ResCol
　　　　aryResult(i, cnt) = aryCompare(numRow + i - 1 + rev.OffRow(numRev) + j - 1, numCol + rev.OffCol(numRev) + k - 1)
　　　　cnt = cnt + 1
　　　Next k
　　Next j
　Next i

　'着色するセル位置を検索
　ReDim blnPaint(1 To rangeResult.Rows.Count, 1 To rangeResult.Columns.Count)
　For i = 1 To rangeResult.Rows.Count
　　For j = numResult To rangeResult.Columns.Count
　　　If aryResult(i, 1) = aryResult(i, j) Then
　　　　blnPaint(i, 1) = True
　　　　blnPaint(i, j) = True
　　　End If
　　Next j
　Next i

　'更新停止
　Application.EnableEvents = False
　Application.ScreenUpdating = False
　Application.Calculation = False
　'セルに出力、着色。
　rangeResult = aryResult 'セルに出力
　For i = 1 To rangeResult.Rows.Count
　　For j = 1 To rangeResult.Columns.Count
　　　If blnPaint(i, j) = True Then
　　　　rangeResult(i, j).Interior.Color = clrCompare
　　　End If
　　Next j
　Next i
　'更新再開
　Application.EnableEvents = True
　Application.ScreenUpdating = True
　Application.Calculation = True
End Sub

お礼

こんばんはmathmi さん。奇しくも失敗でした。

私はM4からにしたのですが、M4の隣のN列は空けておいてO4から、コピーされたリボルビング範囲をペーストしたかったんです。
で、全セルの背景色が黄色くなってしまってました(σ≧▽≦)σ
M列の１つ１つのセルの値に、その１つ１つの行上に等しい値の背景色を色付けするのが目的でもあります。ここが上手くいってなかったポイントです。

ですが、マクロしたときに、バーっと出てきたのが凄くすばらしかったです。ちょっと待ちますと一瞬で出来あがっていつもビックリさせられます。
続いてご協力お願い致します。(^^)/

回答No.2

Mathmi

＞aryResult(i, cnt) = aryCompare(numRow + i - 1 + Rev.OffRow(numRev) + j - 1, numCol + Rev.OffCol(numRev) + k - 1)
＞i,j,kの値は1でした。
申し訳ありません。OffRowを使っているという事は、No19の方のコードでエラーが出た、との事ですね。
こちらで設定を変更してコードを走らせてもエラーは再現できませんでした。

その位置でi,j,k=1の時エラーが発生したとなると、考えられるのはnumResultに0以下の値が設定されている場合です。
一度ご確認下さい。

……エラーの再現を考えると、どこでエラーが起こったと報告していただくよりも、SetDataプロシージャを丸ごと上げて頂くのが、一番早いかもしれません。

***以下、特に読む必要のない余談***
***想定できるバグとエラーが発生し得るかどうかの検討***
・numRowが負の値→rangeCompare(1).Rowが負の値を取ることはないのでありえない。
・numColが負の値→rangeCompare(1).Columnが負の値を取ることはないのでありえない。
・rev.OffRowの最初の値がrangeCompareの最初の値以上→「シート範囲外と比較しようとしています。」のエラートラップに引っかかるのであり得ない。
　例:rangeCompare = myWS.Range("D8:D10000")、rev.OffRow = Array(-10, -12)。8行目から10行前の値を比較しようとしている。
・aryResultの行数が1未満→rangeCompareの行数が0はあり得ない。
・aryResultの列数がnumResult未満→numResult+numCompare-1がnumResult未満になる、つまりnumCompareが0以下になる場合、「比較先行数もしくは列数が0以下です。」のエラートラップに引っかかるのでありえない。
・aryCompareの行数がnumRow+rev.OffRow(0)未満→行数はrangeCompare.Count+rev.OffRowの最大値+rev.ReRow-1なのでありえない。
・aryCompareの列数がnumCol+rev.OffCol(0)未満→列数はrangeCompareの最大の列数+{rev.OffColの最大値+rev.ResCol-1、ただし最低0}なので、rev.OffCol(0)<=rev.OffColの最大値、rev.ResCol-1>=0よりありえない。

お礼

こんにちはmathmiさん＼(^_^)／
あのときからすっかり暑くなりましたね。熱いサポートして頂きありがとうございます。
こんなこと言うのは大変恐縮なんですが一度ストレートにソースを書いて頂きたいのです。
混乱混乱で不必要なものは省いて欲しいです。_(^^;)ゞ