
順を追って具体的に説明致します。
添付画像は、Sheet3の体裁です。
C列1で日付・2で時間・3で約定値・4で出来高をアドインソフトにてリアルタイルに取込でいます。
そして、CDE列各々の12行目から最終行の下空白行へ取込データを入力して行きます。
A列の12行目からは同じ行のC列にデータが有れば、上の行の値に+1して書込み
そのMax値がA9に表示され「作業中行数」と名付けました。
J9は「T設定行数」と名付け、CDE列へ入力されて行く目標行数を表し
その数に応じて、J~O列12行のセル関数で値を算出。
ここまでの処理を
Private Sub Worksheet_Calculate()で書きました。
A9「作業中行数」がJ9「T設定行数」以上に成ったら
J~O列12行のセルの値を
同じbookのSheet2のA~F列の、最終行の下空白行へ
先に開いて置いたファイル(book)のSheet計算のB~G列の、最終行の下空白行へ
各々転記する。
ここまでの処理を
Sub 指定したシートとセル領域にデータ転記()で書きました。
前述の各々の転記が終わったら
C列12行目からE列のJ9(T設定行数)+11行目迄を削除して
C~E列のJ9(T設定行数)+11行目の次の行以降を
12行目迄シフトアップさせる。
このシフトアップは、画像でも確認頂けますが、1秒間に2行以上一気にデータ入力される事が多々あり、取りこぼしを防げると思いそうしました。
ここまでの処理を
Sub 削除後に上方にシフト()で書きました。
シフトアップ後は、再びデータが入力されて行き、
設定行数に達したら、各々へデータの転記、削除・シフトアップ
を、ファイルを閉じるまで、繰り返す様になると思うのですが、分かりません。
その様にしたいです。
ここまでが、完成した時の概略を説明致しました。
因みに起動の順番は、真っ先にリアルタイムに取込む為のエクセルへのアドインソフトを起動
次に、転記させたいファイル(Sheet計算の有るbook)を
最後に、このVBAを書いているファイル(book)をダブルクリック・「更新する」クリックで開きます。
書いたVBAは、以下の如です。
このVBAは、Microsoft Excel ObjectsのSheet3に書いています。
Private Sub Worksheet_Calculate()
Dim myData1
Dim myData2
Dim myData3
myData1 = Worksheets("Sheet3").Range("C3").Value '現在値のRSS取込データ
myData2 = Worksheets("Sheet3").Range("C2").Value '時刻のRSS取込データ
myData3 = Worksheets("Sheet3").Range("C1").Value '日付のRSS取込データ
If Range("C4") > Range("D4") Then 'C4セル(取引毎に出来高が更新され、
'それに応じて現在値・日付・時刻も更新される。
Application.ScreenUpdating = False
Application.EnableEvents = False
With Worksheets("Sheet3")
n = Cells(Rows.Count, "E").End(xlUp).Row + 1
.Range("E" & n).Value = myData1
End With
以下2つWith~End Withが有りますが、構文は上と同じ(1つは"D"・もう1つは"C")なので省略します。
Application.ScreenUpdating = True
Application.EnableEvents = True
End If
Call 指定したシートとセル領域にデータ転記
End Sub
「このプロシージャのみでは、ファイルを閉じるまで、取込に有力続けます。」
-------------------------------
Sub 指定したシートとセル領域にデータ転記()
If Worksheets("Sheet3").Range("A9").Value >= Worksheets("Sheet3").Range("J9").Value Then
「このプロシージャ内にカーソルを置きF5を押せば、各々への転記後に削除・シフトアップします。」
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim 受ws As Worksheet
Dim 最終行の下A
Dim 受最終行下B
Set ws3 = Worksheets("Sheet3")
Set ws2 = Worksheets("Sheet2")
Set 受ws = Workbooks(1).Worksheets("計算")
最終行の下A = ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1
ws2.Range("A" & 最終行の下A).Value = ws3.Range("J12").Value
以下5つ同じ構文が有りますが、省略します。
受最終行下B = 受ws.Cells(Rows.Count, "B").End(xlUp).Row + 1
受ws.Range("B" & 受最終行下B).Value = ws3.Range("J12").Value
以下5つ同じ構文が有りますが、省略します。
Call 削除後に上方にシフト
End If
End Sub
-----------------------
Sub 削除後に上方にシフト()
Dim gyou
gyou = Worksheets("Sheet3").Range("J9").Value
Worksheets("Sheet3").Range("C12:E" & gyou + 11).Delete xlShiftUp
「以下は、削除によってセルに記述していた関数が 「 #REF!」と成った為
対象のセルに関数を書き込む様にしました。」
Worksheets("Sheet3").Range("J12").Value = "=IF($C$12="""","""",$C$12)"
Worksheets("Sheet3").Range("K12").Value = "=IF($D$12="""","""",$D$12)"
Worksheets("Sheet3").Range("L12").Value = "=IF($E$12="""","""",$E$12)"
Worksheets("Sheet3").Range("M12").Value = "=MAX($E$12:OFFSET($E12,$J$9-1,0))"
Worksheets("Sheet3").Range("N12").Value = "=MIN($E$12:OFFSET($E12,$J$9-1,0))"
Worksheets("Sheet3").Range("O12").Value = "=OFFSET($E12,$J$9-1,0)"
Worksheets("Sheet3").Range("A9").Value = "=MAX(A12:A211)"
Worksheets("Sheet3").Cells(12, 1) = "=IF($C12="""","""",1)"
Worksheets("Sheet3").Cells(13, 1).Resize(199, 1).FormulaR1C1 = "=IF(RC3="""","""",R[-1]C+1)"
End Sub
以上の内容で、先の手順の如く実施致しました処
Sub Worksheet_Calculate()でデータが入力されて行き
A9(作成中行数)がJ9(設定行数)と同じ75に成った時に
「実行時エラー'-2147417848(80010108)': 'Range'メソッドは失敗しました'-Worksheet'オブジェクト」のダイアログ出現しました。
デバッグをクリックすると
myData1 = Worksheets("Sheet3").Range("C3").Valueの行が黄色に反転表示
myData1にカーソルを重ねると、「= Empty値」とコメント表示される
しかしSheet3のC3セルを見るとRSSで値は更新変化していました。
解決方法が見出ださません。
エクセルは2013・OSはWindows10です。
どうか宜しく、お教え下さいませ。

No.6ベストアンサー
- 回答日時:
#4で回答した者です
#3様の回答で解ける出来ると存じますが・・・
Application.Calculation = xlCalculationAutomatic
について追記します。
Application.Calculation = xlCalculationAutomatic
終了時に自動再計算に戻す(手動のままでいいのであれば、記述は不要)
戻した場合、再度Worksheet_Calculate()が実行されますので
Application.EnableEvents = Trueのコードより前に実行する必要があります。
流石にローカルで試してみました(コードを読むだけでは限界が・・・)
実際に不明のコードは考えず、参考の為、纏めてみました
一応記します
Option Explicit
Private Sub Worksheet_Calculate()
Dim myData1
Dim myData2
Dim myData3
Dim n As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
With Worksheets("Sheet3")
myData1 = .Range("C3").Value '現在値のRSS取込データ
myData2 = .Range("C2").Value '時刻のRSS取込データ
myData3 = .Range("C1").Value '日付のRSS取込データ
If .Range("C4") > .Range("D4") Then 'C4セル(取引毎に出来高が更新され、
'それに応じて現在値・日付・時刻も更新される。
n = .Cells(Rows.Count, "E").End(xlUp).Row + 1
.Range("E" & n).Value = myData1
'以下2つWith~End Withが有りますが、構文は上と同じ(1つは"D"・もう1つは"C")なので省略します。
End If
If .Range("A9").Value >= .Range("J9").Value Then
Call 指定したシートとセル領域にデータ転記 '標準モジュールに記す場合、モジュールオブジェクト名を加えてください
' Call Module1.指定したシートとセル領域にデータ転記 ' Module1記載例
End If
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
'「このプロシージャのみでは、ファイルを閉じるまで、取込に有力続けます。」
'-------------------------------
Sub 指定したシートとセル領域にデータ転記()
'「このプロシージャ内にカーソルを置きF5を押せば、各々への転記後に削除・シフトアップします。」
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim 受ws As Worksheet
Dim 最終行の下A As Long
Dim 受最終行下B As Long
Set ws3 = Worksheets("Sheet3")
Set ws2 = Worksheets("Sheet2")
Set 受ws = Workbooks(1).Worksheets("計算")
最終行の下A = ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1
ws2.Range("A" & 最終行の下A).Value = ws3.Range("J12").Value
'以下5つ同じ構文が有りますが、省略します。
受最終行下B = 受ws.Cells(Rows.Count, "B").End(xlUp).Row + 1
受ws.Range("B" & 受最終行下B).Value = ws3.Range("J12").Value
'以下5つ同じ構文が有りますが、省略します。
With ws3
.Range("C12:E" & .Range("J9").Value + 11).Delete xlShiftUp
'「以下は、削除によってセルに記述していた関数が 「 #REF!」と成った為
'対象のセルに関数を書き込む様にしました。」
.Range("J12").Value = "=IF($C$12="""","""",$C$12)"
.Range("K12").Value = "=IF($D$12="""","""",$D$12)"
.Range("L12").Value = "=IF($E$12="""","""",$E$12)"
.Range("M12").Value = "=MAX($E$12:OFFSET($E12,$J$9-1,0))"
.Range("N12").Value = "=MIN($E$12:OFFSET($E12,$J$9-1,0))"
.Range("O12").Value = "=OFFSET($E12,$J$9-1,0)"
.Range("A9").Value = "=MAX(A12:A211)"
.Cells(12, 1) = "=IF($C12="""","""",1)"
.Cells(13, 1).Resize(199, 1).FormulaR1C1 = "=IF(RC3="""","""",R[-1]C+1)"
End With
Set ws3 = Nothing
Set ws2 = Nothing
Set 受ws = Nothing
End Sub
fujillin 様
この度は、いろいろとお世話に成り有難うご座いました。
貴重なお時間を、回答に賜りまして有難うご座いました。
無事に解決し、思い描いていた処理すべてが実行できました。
これで、検証する為の最も重要な道具を手にする事が出来ました。
小生VBA初心者にて、皆様のご教授の意味をスムーズに理解出来なくて、
ご迷惑をお掛けし申し訳ございませんでした。
この度は本当に有難うご座いました。重ねて御礼申し上げます。
No.5
- 回答日時:
No3です。
>コンパイルエラー,Ifブロックに対応するEnd Ifが有りません」のダイアログが出現。
ごめんなさい。
質問文のコードが、コメントや説明がごちゃ混ぜなので、
>If Range("C4") > Range("D4") Then
を見落としてしまいました。
その部分に関しては、当方の誤りです。
いろいろと試していらっしゃるようですが、意図がわかりかねますし、文章を読んでも説明がよくわかりません。
推測しているのは、
・セルを削除移動により計算が発生する
・セルに関数式を記入することにで計算が発生する
ことによるオバーフローです。
ですので、ご提示の処理を実行する際にイベント発生を抑制しておけば、少なくともオーバーフローは発生しないと推測しているのですが・・・
No3の回答はそういう意味ですけれど、そのような制御に修正して試していらっしゃいますか?
No.4
- 回答日時:
#1 です
(ご質問コード)
多分、元凶は数式を書き込むところで自動計算が実行される事で
#3様のイベントを止めいる状態で書き込むことで対応できるかと思います
必要であれば
Application.ScreenUpdatingなどと共に
Application.Calculation = xlCalculationManual
計算を手動にする
Application.Calculation = xlCalculationAutomatic
終了時に自動再計算に戻す(手動のままでいいのであれば、記述は不要)
を加えてみてください。
(現状)
>Sub 指定したシートとセル領域にデータ転記()は作動しませんでした。
これは、>各々への転記・削除・シフトアップの処理が行われ、
とあるので、実行されているものと判断します。
出力されないのは、条件に問題があるか、参照先の値が同じ値などと推測します。F5実行ではなくF8の繰り返しで実行して確認してください。
(改修などをする場合)
処理全体が見えないので難しいのですが、
トリガー(処理開始起点)はアドインからの書き込みでしょうか?
CalculateにはTargetが有りませんので
Worksheet_Calculate を Worksheet_Changeなどに変更する事は可能ですか?
可能ならば、トリガーセルをTargetで限定して処理が足るようにするのはどうでしょうか?
あと、
Sub 削除後に上方にシフト() は数式入力ではなく結果の値入力に書き換える事は可能ですか?
一応、数式入力部分をVBAで計算するように書いて見ましたが、
OFFSETで使われているJ9セルの変化で抽出する値は、自動ででなくなるのでWorksheet_Changeなどを使い計算VBAを実行する必要があります。
まあ、ここはロジックを変える場合の参考程度での話です
With Worksheets("Sheet3")
If .Range("C12") <> "" Then .Range("J12") = .Range("C12") Else .Range("J12").Value = ""
If .Range("D12") <> "" Then .Range("K12") = .Range("D12") Else .Range("K12").Value = ""
If .Range("E12") <> "" Then .Range("L12") = .Range("E12") Else .Range("L12").Value = ""
.Range("M12").Value = Application.Max(.Range("E12").Resize(.Range("J9"), 1))
.Range("N12").Value = Application.Min(.Range("E12").Resize(.Range("J9"), 1))
.Range("O12").Value = .Range("E12").Offset(.Range("J9") - 1, .Range("E12") - 1)
If .Cells(12, 1) = "" Then .Cells(12, 1) = "" Else .Cells(12, 1) = 1
If .Cells(12, 1) <> "" Then
i = 2
For Each targetCell In .Cells(13, 1).Resize(199, 1)
If targetCell.Offset(, 2) <> "" Then
targetCell.Value = i
i = i + 1
Else
targetCell.Value = ""
End If
Next
End If
.Range("A9").Value = Application.Max(.Range("A12:A211"))
End With
Qchan1962 様
この度は、いろいろとお世話に成り有難うご座いました。
貴重なお時間を、回答に賜りまして有難うご座いました。
コードをお書き頂き、意味の分からないところでもその通りに書くことで
最後まで記述することが出来ました。
お陰様で無事に解決し、思い描いていた処理すべてが実行できました。
これで、検証する為の最も重要な道具を手にする事が出来ました。
小生VBA初心者にて、皆様のご教授の意味をスムーズに理解出来なくて、
ご迷惑をお掛けし申し訳ございませんでした。
この度は本当に有難うご座いました。重ねて御礼申し上げます。
済みません。 fujillin 様宛のお礼文を、どう間違えたのか、Qchan1962 様の回答日時:2022/05/17 18:18ところに入れてしまいました。
ごめんなさい。感謝致しております。
No.3
- 回答日時:
No2です。
>白紙である「標準モジュール」に貼り付けてみました
どこからそのようなことになったのか不明ですけれど、メモリーには関係ないと思います。
>諦めるしかないのでしょうか。
不明点が多いので、コードを追いかける気にはならないため、内容はわかりませんけれど・・
以下のようにしてもダメでしょうか?
Private Sub Worksheet_Calculate()
Dim myData1
Dim myData2
Dim myData3
Application.EnableEvents = False
Application.ScreenUpdating = False
myData1 = Worksheets("Sheet3").Range("C3").Value '現在値のRSS取込データ
myData2 = Worksheets("Sheet3").Range("C2").Value '時刻のRSS取込データ
myData3 = Worksheets("Sheet3").Range("C1").Value '日付のRSS取込データ
With Worksheets("Sheet3")
n = Cells(Rows.Count, "E").End(xlUp).Row + 1
.Range("E" & n).Value = myData1
End With
’End If ← **** いきなり End If だけあるので文法的におかしい ???*****
Call 指定したシートとセル領域にデータ転記
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
>希望している動作に成らないという事は間違っているのですが
処理内容は見ていませんので、ご希望の動作かはわかりませんけれど、ご質問文にあるエラーは出なくなりませんか?
No.2
- 回答日時:
こんにちは
ご説明の内容が複雑にすぎるので、全く理解できませんけれど・・
雰囲気からの想像ですが、イベント処理でオーバフローしているのではないでしょうか?
以下でも、同様のエラーが簡単に発生します。
シートモジュールに以下を記述の上、test_calc()を直接実行。
Private Sub Worksheet_Calculate()
Dim a
a = Range("A1").Value
Call test_calc
End Sub
Sub test_calc()
Range("B1").FormulaLocal = "=A1&""B"""
End Sub
ご提示のコードにすでに記述はありますが、イベントの発生をきちんと制御することで対処できるのものと思います。
No.1
- 回答日時:
こんにちは
実行時エラー'-2147417848(80010108)': 'Range'メソッドは失敗しました'
このエラーは、アプリケーション側のエラーのようです
負荷が高い処理を行うと起こりやすいようなので沼が深いかも知れません
問題を具体的に示す事は難しいので取り敢えず、処理負荷を減らす
コード、ロジックに変更する事が有効かもしれません。
未検証(ざっくり)なので具体的添削はやめときますが
数式を書き込むところで一旦自動計算を止め、纏めて再開とか
End Sub
-----------------------
Sub 削除後に上方にシフト()
これについては1つのプロシージャにした方がメモリ負担は減るかも知れません
With オブジェクト で同じオブジェクトに対して行う処理を
纏めるとか・・・
アドイン動作を考慮して適所に DoEventsなどを入れるとか・・
ロジック自体変更して、
Worksheet_Calculateでループするような事をやめ
別のトリガーを考えるとか・・・
適当に上げても仕方ありませんが取り敢えず・・
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 稀に1円合いません? Sheet1から金額と個数を貼り付ける下記コードで、金額を切り上げるコードを何 3 2022/09/05 15:11
- Visual Basic(VBA) 別シートのデータを参照して値を入れたい。 まとめデータシートのC列D列の値を商品一覧シートのコードが 7 2022/08/17 13:20
- Visual Basic(VBA) VBAが止まります。 3 2022/08/31 14:09
- Visual Basic(VBA) VBAコードが作動せず、どこに問題があるのか教えて下さい。 3 2023/06/13 13:20
- Visual Basic(VBA) VBAでoutlook365が起動しません。 4 2022/08/25 13:31
- Visual Basic(VBA) Sheet「状況」から、分類の年齢別カウント数をSheet「D表」へ転記する下記マクロを作っています 7 2022/12/14 17:57
- Visual Basic(VBA) 配列の勉強をしています。使用する変数の意味、検索条件の書き方が難しいです。 2 2022/09/15 14:06
- Visual Basic(VBA) excel2021で実行できないマクロ。どこを直したらいいのか 2 2022/03/28 03:40
- Excel(エクセル) なぜExit Subがあるのかわかりません 4 2023/02/19 12:34
- Visual Basic(VBA) 前回ご教授いただいたコードに覚えたてのループ処理で品名りんごAから順に20回for nextでループ 7 2023/01/13 22:01
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・一番好きなみそ汁の具材は?
- ・泣きながら食べたご飯の思い出
- ・「これはヤバかったな」という遅刻エピソード
- ・初めて自分の家と他人の家が違う、と意識した時
- ・いちばん失敗した人決定戦
- ・思い出すきっかけは 音楽?におい?景色?
- ・あなたなりのストレス発散方法を教えてください!
- ・もし10億円当たったら何に使いますか?
- ・何回やってもうまくいかないことは?
- ・今年はじめたいことは?
- ・あなたの人生で一番ピンチに陥った瞬間は?
- ・初めて見た映画を教えてください!
- ・今の日本に期待することはなんですか?
- ・集中するためにやっていること
- ・テレビやラジオに出たことがある人、いますか?
- ・【お題】斜め上を行くスキー場にありがちなこと
- ・人生でいちばんスベッた瞬間
- ・コーピングについて教えてください
- ・あなたの「プチ贅沢」はなんですか?
- ・コンビニでおにぎりを買うときのスタメンはどの具?
- ・おすすめの美術館・博物館、教えてください!
- ・【お題】大変な警告
- ・洋服何着持ってますか?
- ・みんなの【マイ・ベスト積読2024】を教えてください。
- ・「これいらなくない?」という慣習、教えてください
- ・今から楽しみな予定はありますか?
- ・AIツールの活用方法を教えて
- ・最強の防寒、あったか術を教えてください!
- ・歳とったな〜〜と思ったことは?
- ・モテ期を経験した方いらっしゃいますか?
- ・好きな人を振り向かせるためにしたこと
- ・スマホに会話を聞かれているな!?と思ったことありますか?
- ・それもChatGPT!?と驚いた使用方法を教えてください
- ・見学に行くとしたら【天国】と【地獄】どっち?
- ・これまでで一番「情けなかったとき」はいつですか?
- ・この人頭いいなと思ったエピソード
- ・あなたの「必」の書き順を教えてください
- ・14歳の自分に衝撃の事実を告げてください
- ・人生最悪の忘れ物
- ・あなたの習慣について教えてください!!
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excelのマクロについて教えてく...
-
VBAの「To」という語句について
-
ExcelのVBAコードについて教え...
-
算術演算子「¥」の意味について
-
質問58753 このコードでうまく...
-
VBAについてです。 どなたかご...
-
えくせるのVBAコードについて教...
-
vbaマクロについて
-
VBAでユーザーフォームを指定回...
-
VBAでセルの書式を変えずに文字...
-
VBA ユーザーフォーム ボタンク...
-
エクセルのVBAコードについて教...
-
VBAでFOR NEXT分を Application...
-
以下のプログラムの実行結果は...
-
VBA Application.Matchについて...
-
【ExcelVBA】5万行以上のデー...
-
エクセルのマクロについて教え...
-
Excelマクロで、ピボットテーブ...
-
エクエルのVBAコードについて教...
-
ExcelのVBAコードについて教え...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
VB.net 文字列から日付型へ変更...
-
VBA 最終行の取得がうまくいか...
-
VBAでエクセルのテキストデータ...
-
【ExcelVBA】5万行以上のデー...
-
エクセルVBAで在庫の組み換え処...
-
VBAから書き込んだ条件付き初期...
-
エクセルのVBAコードについて教...
-
VBAでユーザーフォームを指定回...
-
エクセルのVBAについて教えてく...
-
vbaマクロについて
-
ExcelのVBAコードについて教え...
-
【VBA】 結合セルに複数画像と...
-
WindowsのOutlook を VBA から...
-
質問58753 このコードでうまく...
-
ExcelのVBAコードについて教え...
-
Excel VBAについて。こんな動作...
-
[Excel VBA]特定の条件で文字を...
-
[VB.net] ボタン(Flat)のEnable...
-
エクエルのVBAコードについて教...
-
ExcelのVBAコードについて教え...
おすすめ情報
Qchan様・fujillin様この度のご回答有難うご座います。
お教えを踏まえ
メモリ負担を軽減の目的でプロシージャを以下の様に分けて書いてみました。
VBA初心者で、お二人様のご回答を100%理解出来ませんでしたが試してみました。
試み:
Sub Worksheet_Calculate()はそのままMicrosoft Excel ObjectsのSheet3上に置いて置き
Sub 指定したシートとセル領域にデータ転記()と
Sub 削除後に上方にシフト()を切取って
白紙である「標準モジュール」に貼り付けてみました。
結果:
Sub Worksheet_Calculate()で、
CDE列各々の12行目から最終行の下空白行へデータが入力されて行きます。
A9(作成中行数)がJ9(設定行数)と同じ75に成っても
「標準モジュール」に移動した
Sub 指定したシートとセル領域にデータ転記()と
Sub 削除後に上方にシフト()の処理は、実行されませんでした。
尚、Sub Worksheet_Calculate()の処理は継続していました。
希望している動作に成らないという事は間違っているのですが、
諦めるしかないのでしょうか。
fujillin様 早速のご教授有難うご座います。
文法的におかしいEnd Ifの頭に「'」を付してコメント化して試しました。
結果:「コンパイルエラー,Ifブロックに対応するEnd Ifが有りません」のダイアログが出現。
よって、
Call 指定したシートとセル領域にデータ転記
End Ifと前後を入替て起動。
順調にデータ取込開始し、
Call 指定したシートとセル領域にデータ転記の条件に成ったところで
質問時の実行時エラーが出現致しました。ご報告申し上げます。
それから
Private Sub Worksheet_Calculate()は、Call 指定したシートとセル領域にデータ転記を削除して
今まで通りMicrosoft Excel ObjectsのSheet3に書いき
Microsoft Excel ObjectsのSub 削除後に上方にシフト()に書いていた
Sub 指定したシートとセル領域にデータ転記()と
連携するSub 削除後に上方にシフト()内容をを、「標準モジュール」へ貼付移動したのです。
理由は、プログラムを別のところに書くことで、それぞれが個別に動作処理するのではと思ったからです。
その結果、Sub Worksheet_Calculate()は動作処理しているようですが、
Sub 指定したシートとセル領域にデータ転記()の処理が、条件を満たした時にも
動作処理(各々の所への転記)をしないようです。
従って、連携するSub 削除後に上方にシフト()も行われません。
リアルタイムの取込を止め、77行分のデータをSheet3のCDE列各々の12行目より貼付
「標準モジュール」に書いたSub 指定したシートとセル領域にデータ転記()内にカーソルを置き
F5を押すと、各々への転記・削除・シフトアップの処理が行われ、
77行-75行の2行がCDE列12・13行目に残りました。
次に、77行分のデータを一気に貼付けず、74行分を先に貼付、
条件をクリアする様にと、75・76・77の3行を後で貼付ましたが、
Sub 指定したシートとセル領域にデータ転記()は作動しませんでした。
何故かはわかりません。
以上、今まで試しました事をご報告致します。