(VBAにて)シート間のコピーの文字数限界ついて

質問

質問が抽象的ですみませんが、質問させて頂きますので
宜しくお願いします。
(まだVBAの日が浅い者です。)

・Excelにて障害管理表というものを作成しています。(sheet1に)
　・発生日時や障害内容などが列ごとに管理されている表です。
　・各項目名がA3～Y3で各データがA4～Y60まで入力されています。)
　・今後も障害が発生することにより、行数が増えていきます。

・sheet2について
　・マクロ用の専用シートにしています。
　・コマンドボタンを作成し、そこにマクロ文を挿入しています。
　・マクロ文の内容は、sheet1の[F列:発生日時]をキーにして、
　 sheet2の「セルA1→開始年月]「セルB2→終了年月]を入力して
　 コマンドボタンを押す
　・sheet1よりsheet3に指定した期間内のみデータを表示させる。
というのが大筋の内容です。

大体うまく行きましたが、1つだけ問題点が出ました。
　・[sheet1のP列]には対応内容のデータが入力されています。
　・sheet3のP列にほぼコピーは出来たのですが、2件ほどが
　　sheet3のP列に反映されず、空白のままとなってしまいます。
　・調べてみると、2件ともかなりの文字数がsheet1のP列に入力されていました。
　(実際は)
マクロ文を実行すると、下記のエラーが出て処理がSTOPしてしまいます。
　　「実行時エラー'1004':
アプリケーション定義またはオブジェクト定義のエラーです。」
　　 　　　　↓
(P列の長い文字数をsheet1～sheet3へコピーする所です。

ですので、「On Error GoTo 0～On Error Resume Next」コマンドを使用してエラーを吹っ飛ばして処理を続行しています。(2件は反映されませんが。)

・シート間でセル内容をコピーする時の文字数の限界ってあるのでしょうか？
・また、どのようにすれば解消されるでしょうか？
　　　・因みに、sheet1の例の2件の文字数をかなり削除したらうまく行きました。)
　　 ・sheet1の例の2件の文字数を削らず、sheet3のP列の文字を小さく設定してもセルを最大に広げてもダメでした。)

長くなって申し訳ありませんが宜しくお願い致します。

回答No.2

Wendy02 · ベストアンサー

こんにちは。

>On Error Resume Next
>　sh3.Cells(K, "P") = sh1.Cells(i, "P")
>On Error GoTo 0

つまり、ここの部分ですね。

実行時エラーですから、それは、こちらでは、はっきりしたことがいえませんから、
まず、いくつかの検査が必要です。

最初、そのコードから言えるのは、

　・セルの文字列の制限は、32,767文字(全角・半角は区別がない）
　・セルの中に、制御コード等が入ったりすると、影響を受ける可能性がある
この２点を思いつきます。

また、プロパティを入れたほうが無難だということです。
　　sh3.Cells(K, "P").Value = sh1.Cells(i, "P").Value
または、
　　sh3.Cells(K, "P").Text = sh1.Cells(i, "P").Text

そして、

診断用として、このようなテストをしてみたらどうでしょうか？
ローカルウィンドウも出しておいてください。

エラーが出たときに、その値を取ってみるわけです。

On Error Resume Next
　sh3.Cells(K, "P") = sh1.Cells(i, "P")
　If Err.Number > 0 Then
　　Stop 'ここからステップモード(VBE で、F8)
　　a =sh3.Cells(K, "P")
　　b= sh1.Cells(i, "P")　　
　　Debug.Print a, b
　End If
On Error GoTo 0

それで、もし、必要なかったら、継続しないで、中途で、マクロを終わらせてしまってもよいです。

お礼

回答ありがとうございました。
sh3.Cells(K, "P").Value = sh1.Cells(i, "P").Value
に変えた所、成功しました。
原因は文字数では無く、制御コードぽいです。
助かりました、ありがとうございます。

回答No.1

Wendy02

こんにちは。

>マクロ文を実行すると、下記のエラーが出て処理がSTOPしてしまいます。
>　　「実行時エラー'1004':
>アプリケーション定義またはオブジェクト定義のエラーです。」

そのエラーを出した部分と、その周辺を公開してください。
そうしないと、話が前に進まないです。

>・シート間でセル内容をコピーする時の文字数の限界ってあるのでしょうか？

それを、今、ここで話を出しても始まらないと思います。一般的にははるかな大きな量です。

補足

返信ありがとうございます。
ちょっと説明の数字が違っている箇所があるかと思いますが、
質問内容は同じですので宜しくお願いします。
(長いので、下の方は省いています。足りない場合は
再度転記します。)

Private Sub CommandButton1_Click()

Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Set sh1 = Worksheets("インシデント管理台帳(F07)")
Set sh2 = Worksheets("まくろ")
Set sh3 = Worksheets("印刷用シート")

Sheets(Sheets.Count).Activate
sh3.Rows("3:60").Select
Selection.RowHeight = 409

sh3.Range( _
"A3:A4,B3:B4,C3:C4,D3:D4,E3:E4,F3:F4,G3:G4,H3:H4,I3:I4,J3:J4,K3:K4,L3:L4,M3:M4,N3:N4,O3:O4,P3:P4,Q3:Q4,R3:R4,S3:S4,T3:T4,U3:U4,V3:V4,W3:W4,X3:X4,Y3:Y4" _
).Select
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
sh3.Range("A3:Y4").Select
Selection.Copy
sh3.Range("A5:Y30").Select
ActiveSheet.Paste
sh3.Range("I27:I28").Select
Application.CutCopyMode = False

sh3.Rows("3:30").Select
Selection.RowHeight = 409

d = sh1.Range("F65536").End(xlUp).Row

K = 3
f = sh2.Range("A2")
t1 = sh2.Range("B2")

'
t = DateSerial(Year(t1), Month(t1) + 1, 1) - 1

For i = 4 To d
If sh1.Cells(i, "F") >= f And sh1.Cells(i, "F") <= t Then

sh3.Cells(K, "A") = sh1.Cells(i, "A")
sh3.Cells(K, "B") = sh1.Cells(i, "B")
sh3.Cells(K, "C") = sh1.Cells(i, "C")
sh3.Cells(K, "D") = sh1.Cells(i, "D")
sh3.Cells(K, "E") = sh1.Cells(i, "E")
sh3.Cells(K, "F") = sh1.Cells(i, "F")
sh3.Cells(K, "G") = sh1.Cells(i, "G")
sh3.Cells(K, "H") = sh1.Cells(i, "H")
sh3.Cells(K, "I") = sh1.Cells(i, "I")
sh3.Cells(K, "J") = sh1.Cells(i, "J")
sh3.Cells(K, "K") = sh1.Cells(i, "K")
sh3.Cells(K, "L") = sh1.Cells(i, "L")
sh3.Cells(K, "M") = sh1.Cells(i, "M")
sh3.Cells(K, "N") = sh1.Cells(i, "N")
sh3.Cells(K, "O") = sh1.Cells(i, "O")
On Error Resume Next
sh3.Cells(K, "P") = sh1.Cells(i, "P")
On Error GoTo 0
sh3.Cells(K, "Q") = sh1.Cells(i, "Q")
sh3.Cells(K, "R") = sh1.Cells(i, "R")
sh3.Cells(K, "S") = sh1.Cells(i, "S")
sh3.Cells(K, "T") = sh1.Cells(i, "T")
sh3.Cells(K, "U") = sh1.Cells(i, "U")
sh3.Cells(K, "V") = sh1.Cells(i, "V")
sh3.Cells(K, "W") = sh1.Cells(i, "W")
sh3.Cells(K, "X") = sh1.Cells(i, "X")
sh3.Cells(K, "Y") = sh1.Cells(i, "Y")

K = K + 2

End If

Next i

Sheets(Sheets.Count).Activate

sh1.Range("A3:Y3").Copy _
Destination:=sh3.Range("A2")

sh3.Range("B:B,E:E,I:I,L:M,R:T,V:W").Delete