teratail
回答率
85.36%
teratail 10th-anniversary
teratail 10th-anniversary
質問するログイン新規登録
トップVBAに関する質問実行時エラー´－2147417848(80010108)について

編集履歴

回答編集履歴

2

ソース修正

2020/03/18 07:05

投稿

yureighost
yureighost

スコア2183

test CHANGED
@@ -1,8 +1,10 @@
1
+ コメントで伺いましたが、
2
+
3
+ 数式を値で上書きする処理はセルのValueに値を代入することでコピー&ペーストより高速にできますので修正してみました。
4
+
1
- ざっくり見ただけですが、これぐらい処理いらない気がしますね。
5
+ この部分とV列のところで列を挿入する処理を選択処理なしで直接行うようにしました。
2
-
3
- 不要と思った部分はシングルクォーテーションでコメント化してるので
6
+
4
-
5
- これでまだエラーが出るか、処理に問題がないか確認してみてください。
7
+ ただV列より右列にデータが非常に多いなどするとどうしようもないかも知れないですが、試してみてください。
6
8
 
7
9
  ```VBA
8
10
 
@@ -10,6 +12,10 @@
10
12
 
11
13
 
12
14
 
15
+ '数式を値で上書き
16
+
17
+ Range("A2:G2").Value = Range("A2:G2").Value
18
+
13
19
  'Range("A2:G2").Select
14
20
 
15
21
  'Application.CutCopyMode = False
@@ -22,146 +28,160 @@
22
28
 
23
29
  Rows("7:7").Select
24
30
 
31
+ Application.CutCopyMode = False
32
+
33
+ Selection.Copy
34
+
35
+ Rows("8:797").Select
36
+
37
+ ActiveSheet.Paste
38
+
39
+ '数式を値で上書き
40
+
41
+ Range("B7", Range("B7").SpecialCells(xlLastCell)).Value = Range("B7", Range("B7").SpecialCells(xlLastCell)).Value
42
+
43
+ Range("B7", Range("B7").SpecialCells(xlLastCell)).Replace What:="delete", Replacement:="", LookAt:=xlPart, _
44
+
45
+ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
46
+
47
+ ReplaceFormat:=False
48
+
49
+ 'Range("B7").Select
50
+
51
+ 'Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
52
+
25
53
  'Application.CutCopyMode = False
26
54
 
27
- Selection.Copy
55
+ 'Selection.Copy
56
+
28
-
57
+ 'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
58
+
59
+ ' :=False, Transpose:=False
60
+
61
+ 'Selection.Replace What:="delete", Replacement:="", LookAt:=xlPart, _
62
+
63
+ ' SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
64
+
65
+ ' ReplaceFormat:=False
66
+
67
+ '選択なしで列を挿入
68
+
69
+ Columns("V:V").Insert Shift:=xlToRight
70
+
29
- Rows("8:797").Select
71
+ 'Columns("V:V").Select
30
-
31
- ActiveSheet.Paste
32
-
33
- Range("B7").Select
34
-
35
- Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
36
72
 
37
73
  'Application.CutCopyMode = False
38
74
 
39
- 'Selection.Copy
75
+ 'Selection.Insert Shift:=xlToRight
76
+
40
-
77
+ Range("V7").Select
78
+
79
+ ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""",""F"",RC[-1])"
80
+
81
+ Range("V7").Select
82
+
83
+ Selection.AutoFill Destination:=Range("V7:V797"), Type:=xlFillDefault
84
+
85
+ Range("V7:V797").Select
86
+
87
+ Rows("7:7").Select
88
+
89
+ Range(Selection, Selection.End(xlDown)).Select
90
+
91
+ ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Clear
92
+
93
+ ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("N7:N797"), _
94
+
41
- 'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
95
+ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
96
+
42
-
97
+ ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("V7:V797"), _
98
+
99
+ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
100
+
101
+ ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("J7:J797"), _
102
+
103
+ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
104
+
105
+ ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("L7:L797"), _
106
+
107
+ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
108
+
109
+ ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("F7:F797"), _
110
+
111
+ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
112
+
113
+ With ActiveWorkbook.Worksheets("【F】").Sort
114
+
115
+ .SetRange Range("A7:HN797")
116
+
117
+ .Header = xlGuess
118
+
119
+ .MatchCase = False
120
+
121
+ .Orientation = xlTopToBottom
122
+
123
+ .SortMethod = xlPinYin
124
+
125
+ .Apply
126
+
127
+ End With
128
+
129
+
130
+
43
- ' :=False, Transpose:=False
131
+ 'Application.ScreenUpdating = False
132
+
133
+
134
+
44
-
135
+ ActiveSheet.Range("$A$6:$HK$797").AutoFilter Field:=14, Criteria1:="ヨコ"
136
+
137
+ ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Clear
138
+
139
+ ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("N7:N797"), _
140
+
141
+ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
142
+
143
+ ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("V7:V797"), _
144
+
145
+ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
146
+
45
- Selection.Replace What:="delete", Replacement:="", LookAt:=xlPart, _
147
+ ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("L7:L797"), _
46
-
148
+
47
- SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
149
+ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
150
+
48
-
151
+ ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("J7:J797"), _
152
+
153
+ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
154
+
155
+ ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("F7:F797"), _
156
+
157
+ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
158
+
159
+ With ActiveWorkbook.Worksheets("【F】").Sort
160
+
161
+ .SetRange Range("A144:HN797")
162
+
163
+ .Header = xlGuess
164
+
49
- ReplaceFormat:=False
165
+ .MatchCase = False
166
+
167
+ .Orientation = xlTopToBottom
168
+
169
+ .SortMethod = xlPinYin
170
+
171
+ .Apply
172
+
173
+ End With
174
+
175
+
176
+
177
+ 'Application.ScreenUpdating = False
178
+
179
+
180
+
181
+ ActiveSheet.ShowAllData
50
182
 
51
183
  Columns("V:V").Select
52
184
 
53
- 'Application.CutCopyMode = False
54
-
55
- Selection.Insert Shift:=xlToRight
56
-
57
- Range("V7").Select
58
-
59
- ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""",""F"",RC[-1])"
60
-
61
- 'Range("V7").Select
62
-
63
- Selection.AutoFill Destination:=Range("V7:V797"), Type:=xlFillDefault
64
-
65
- 'Range("V7:V797").Select
66
-
67
- Rows("7:7").Select
68
-
69
- Range(Selection, Selection.End(xlDown)).Select
70
-
71
- ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Clear
72
-
73
- ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("N7:N797"), _
74
-
75
- SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
76
-
77
- ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("V7:V797"), _
78
-
79
- SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
80
-
81
- ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("J7:J797"), _
82
-
83
- SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
84
-
85
- ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("L7:L797"), _
86
-
87
- SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
88
-
89
- ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("F7:F797"), _
90
-
91
- SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
92
-
93
- With ActiveWorkbook.Worksheets("【F】").Sort
94
-
95
- .SetRange Range("A7:HN797")
96
-
97
- .Header = xlGuess
98
-
99
- .MatchCase = False
100
-
101
- .Orientation = xlTopToBottom
102
-
103
- .SortMethod = xlPinYin
104
-
105
- .Apply
106
-
107
- End With
108
-
109
-
110
-
111
- 'Application.ScreenUpdating = False
112
-
113
-
114
-
115
- ActiveSheet.Range("$A$6:$HK$797").AutoFilter Field:=14, Criteria1:="ヨコ"
116
-
117
- ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Clear
118
-
119
- ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("N7:N797"), _
120
-
121
- SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
122
-
123
- ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("V7:V797"), _
124
-
125
- SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
126
-
127
- ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("L7:L797"), _
128
-
129
- SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
130
-
131
- ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("J7:J797"), _
132
-
133
- SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
134
-
135
- ActiveWorkbook.Worksheets("【F】").Sort.SortFields.Add Key:=Range("F7:F797"), _
136
-
137
- SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
138
-
139
- With ActiveWorkbook.Worksheets("【F】").Sort
140
-
141
- .SetRange Range("A144:HN797")
142
-
143
- .Header = xlGuess
144
-
145
- .MatchCase = False
146
-
147
- .Orientation = xlTopToBottom
148
-
149
- .SortMethod = xlPinYin
150
-
151
- .Apply
152
-
153
- End With
154
-
155
-
156
-
157
- 'Application.ScreenUpdating = False
158
-
159
-
160
-
161
- ActiveSheet.ShowAllData
162
-
163
- Columns("V:V").Select
164
-
165
185
  Selection.Delete Shift:=xlToLeft
166
186
 
167
187
  Range("B3:B6").Select

1

ソース修正

2020/03/18 07:05

投稿

yureighost
yureighost

スコア2183

test CHANGED
File without changes