実行時エラー´－2147417848(80010108)について

2020/03/18 04:17

大体、 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False でエラーになっています。

2020/03/18 04:22

シート名だけ【F】にしてセルに何も入力しない分には処理は通りますね。使っている人全員で発生しているわけではないこと。オートメーションエラーという点で処理自体が不正なわけではなくて負荷等の問題だと思うんですが。完全に記録したマクロを編集して作ったようなソースなので効率よく書き直せというのも厳しそうな気がします。

2020/03/18 05:18

その Selection.PasteSpecial Paste～のところですが、その処理が出ている部分二つとも Selection.Copy Selection.PasteSpecial Paste～とコピーから貼り付け処理の間に、別のセルをSelectする処理を入れていないので、同じ選択範囲で「コピー→形式を選択して貼り付ける」の動作をやっていることになります。この部分いらない気がするのですが、一体何をやっている処理なのでしょうか。

2020/03/18 05:19

マクロはやり始めたばかりで、マクロを記録するから大体の動きを入れてから行数などを修正するやり方しか出来ず…勉強不足で申し訳ございません。

2020/03/18 05:56

一番初めの Range("A2:G2").Select Application.CutCopyMode = False Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False は、セル内に作成日時を記録するために =TEXT(FLOOR(NOW(),"0:30:0"),"yｙｙy/mm/dd/h:mm") の関数が入っています。作成日時が進まないようにこのセルをコピーしてそのまま値貼り付けをしています。

2020/03/18 06:11

理解しました。数式を値で上書きしてるってことですね。

行動規範の内容に同意します

回答3件

ベストアンサー

コメントで伺いましたが、
数式を値で上書きする処理はセルのValueに値を代入することでコピー&ペーストより高速にできますので修正してみました。
この部分とV列のところで列を挿入する処理を選択処理なしで直接行うようにしました。
ただV列より右列にデータが非常に多いなどするとどうしようもないかも知れないですが、試してみてください。

VBA
1    Application.ScreenUpdating = False
2
3    '数式を値で上書き
4    Range("A2:G2").Value = Range("A2:G2").Value
5    'Range("A2:G2").Select
6    'Application.CutCopyMode = False
7    'Selection.Copy
8    'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
9    '    :=False, Transpose:=False
10    Rows("7:7").Select
11    Application.CutCopyMode = False
12    Selection.Copy
13    Rows("8:797").Select
14    ActiveSheet.Paste
15    '数式を値で上書き
16    Range("B7", Range("B7").SpecialCells(xlLastCell)).Value = Range("B7", Range("B7").SpecialCells(xlLastCell)).Value
17    Range("B7", Range("B7").SpecialCells(xlLastCell)).Replace What:="delete", Replacement:="", LookAt:=xlPart, _
18        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
19        ReplaceFormat:=False
20    'Range("B7").Select
21    'Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
22    'Application.CutCopyMode = False
23    'Selection.Copy
24    'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
25    '    :=False, Transpose:=False
26    'Selection.Replace What:="delete", Replacement:="", LookAt:=xlPart, _
27    '    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
28    '    ReplaceFormat:=False
29    '選択なしで列を挿入
30    Columns("V:V").Insert Shift:=xlToRight
31    'Columns("V:V").Select
32    'Application.CutCopyMode = False
33    'Selection.Insert Shift:=xlToRight
34    Range("V7").Select
35    ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""",""F"",RC[-1])"
36    Range("V7").Select
37    Selection.AutoFill Destination:=Range("V7:V797"), Type:=xlFillDefault
38    Range("V7:V797").Select
39    Rows("7:7").Select
40    Range(Selection, Selection.End(xlDown)).Select
41    ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Clear
42    ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("N7:N797"), _
43        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
44    ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("V7:V797"), _
45        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
46    ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("J7:J797"), _
47        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
48    ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("L7:L797"), _
49        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
50    ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("F7:F797"), _
51        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
52    With ActiveWorkbook.Worksheets("【F】").Sort
53        .SetRange Range("A7:HN797")
54        .Header = xlGuess
55        .MatchCase = False
56        .Orientation = xlTopToBottom
57        .SortMethod = xlPinYin
58        .Apply
59    End With
60
61    'Application.ScreenUpdating = False
62
63    ActiveSheet.Range("$A$6:$HK$797").AutoFilter Field:=14, Criteria1:="ヨコ"
64    ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Clear
65    ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("N7:N797"), _
66        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
67    ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("V7:V797"), _
68        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
69    ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("L7:L797"), _
70        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
71    ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("J7:J797"), _
72        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
73    ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("F7:F797"), _
74        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
75    With ActiveWorkbook.Worksheets("【F】").Sort
76        .SetRange Range("A144:HN797")
77        .Header = xlGuess
78        .MatchCase = False
79        .Orientation = xlTopToBottom
80        .SortMethod = xlPinYin
81        .Apply
82    End With
83
84    'Application.ScreenUpdating = False
85
86    ActiveSheet.ShowAllData
87    Columns("V:V").Select
88    Selection.Delete Shift:=xlToLeft
89    Range("B3:B6").Select
90    Selection.Replace What:="部受付", Replacement:="済", LookAt:=xlPart, _
91        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
92        ReplaceFormat:=False
93    Selection.Replace What:="事前", Replacement:="前", LookAt:=xlPart, _
94        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
95        ReplaceFormat:=False
96    Selection.Replace What:="事後", Replacement:="後", LookAt:=xlPart, _
97        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
98        ReplaceFormat:=False
99    Selection.Replace What:="いる", Replacement:="有", LookAt:=xlPart, _
100        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
101        ReplaceFormat:=False
102    Selection.Replace What:="いない", Replacement:="無", LookAt:=xlPart, _
103        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
104        ReplaceFormat:=False
105    Range("K7").Select
106    
107    Application.ScreenUpdating = True

投稿2020/03/18 05:49

編集2020/03/18 07:05

総合スコア2183

2020/03/18 06:47

添削ありがとうございます。不要な部分を削除して行いました。自分のPCでは問題がなかったので、エラーが出る方のPCで試してみました。結果は、表題と同じエラーが出ました。エラー箇所は Selection.Insert Shift:=xlToRight⇐ココ Range("V7").Select ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""",""F"",RC[-1])"

2020/03/18 08:27

再度ありがとうございます。こちらのマクロで行ったところ、1人を除いて他は出来るようになりました。ありがとうございます。残りの一人は他のエクセルシートでもエラーを出しているので、また別の原因かと思います。

2020/03/18 10:32

動いて良かったです。エラーの原因はやっぱり処理の重さだと思います。マクロの記録は便利なんですが、VBAとして動かすには効率が悪すぎるのでこういうことが起こりやすくなります。記録で作ったソースを改造するみたいな形でいいので少しずつでもVBAが書けるように頑張ってください。

行動規範の内容に同意します

殆どのセンテンスがブック・シートを指定していないので、アクティブブックかつアクティブシートを前提とした実装になっている点が気になります。

切り分け

ActiveWorkbook の部分を ThisWorkbookに変えたらどうか？
アクティブシート前提で記述されている箇所を ThisWorkbook.Sheets("???"). に変更したらどうか？

（???には目的のシート名を設定する）

修正依頼にも記載しましたが、実際にどのコードでエラーが発生しているのかが分かるとそれも手掛かりになります。

投稿2020/03/18 03:45

DreamTheater

総合スコア1095

2020/03/18 05:16

ThisWorkbook.Sheets("【F】")に変更してやってみましたが、表題と同じエラーが出ました。エラーの場所は前と異なり Selection.Insert Shift:=xlToRight⇐ココ Range("V7").Select ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""",""F"",RC[-1])" でした。

DreamTheater

2020/03/18 05:35

ボタンクリックしてから終わるまで他の操作（別のEXCELブックを開いたり）はされていないですよね？

2020/03/18 05:49

ボタンクリックから動作終了までは一切何もせずに放置しています。また、開いてるエクセルブックも1つの状態で行っております。

Y.H.

2020/03/18 08:34

再計算に時間がかかるシート（ブック）だったりしませんか？ Application.Calculation = xlCalculationManual '手動計算入れてみるとか。

行動規範の内容に同意します

マクロの最初と最後に

Application.ScreenUpdating = False
Application.ScreenUpdating = True

とコーディングするとどうなりますか？

ネットでは、上記記述で同一のエラーメッセージが
回避できたかたがいます。

投稿2020/03/18 02:28

総合スコア1015

2020/03/18 04:18

回答ありがとうございます。 Application.ScreenUpdating = True を追加したマクロでまずは試してみたいと思います。

2020/03/18 04:59

結果 3回試したところ 1回目⇒成功 2回目⇒エラー表示なく終了したが反映するデータ数が少ない(797行分ある筈が769行分までしかなかった) 3回目⇒表題と同じエラーが出る完全な解決にはなりませんでした。

2020/03/18 05:02

コードを入力するのは1行だけではなく2行です最初と最後です。

2020/03/18 05:22

すみません。表記が抜けておりました。最初と最後に Application.ScreenUpdating = False Application.ScreenUpdating = True を入れた状態で試しました。

2020/03/18 05:47

該当のエラーメッセージは負荷が高い処理を行うと起こりやすいようで対処方はここがまずい！と的確に指摘することが難しいエラーメッセージです。まずは、対処法として負荷を減らすことから始め。関連のオブジェクトは、省略せず、最初から記述し Range("A1") の様に記載するのではなく、ブック.シート.Range("A1")とし、メモリーフルの状態を無くすことが大切かと思います。また、落ちる箇所が常に同じ場所であれば、落ちる直前にブレークをかけ、変数の中身をチェックして下さい。

2020/03/18 06:53

対処法をありがとうございます。負荷が高いのが原因なんですね… 作業を分割して複数ののマクロを順番に起動するは、負荷量は変化ないでしょうか？