回答編集履歴

2

コード修正

2020/10/28 03:22

投稿

hatena19
hatena19

スコア33742

test CHANGED
@@ -46,11 +46,15 @@
46
46
 
47
47
  Sub Sample1()
48
48
 
49
+ Application.ScreenUpdating = False
50
+
51
+
52
+
49
53
  Dim tbl As Range
50
54
 
51
- Set tbl = Range("A1").CurrentRegion '表範囲取得
55
+ Set tbl = Range("A1").CurrentRegion
52
56
 
53
- Set tbl = tbl.Resize(tbl.Rows.Count, tbl.Columns.Count + 1) '作業列追加
57
+ Set tbl = tbl.Resize(, tbl.Columns.Count + 1) '作業列追加
54
58
 
55
59
 
56
60
 
@@ -60,16 +64,20 @@
60
64
 
61
65
  workCol.Formula = "=IF(AND(A2=A3,B2=B3,D3=""未確定"",D2=""確定"",C3<=C2),1,0)"
62
66
 
63
-
64
67
 
65
- tbl.AutoFilter Field:=6, Criteria1:="1"
66
68
 
69
+ tbl.AutoFilter Field:=6, Criteria1:="1"
70
+
67
- tbl.Offset(1).EntireRow.Delete
71
+ tbl.Offset(1).EntireRow.Delete
68
72
 
69
73
  tbl.AutoFilter
70
74
 
71
75
  workCol.Clear
72
76
 
77
+
78
+
79
+ Application.ScreenUpdating = True
80
+
73
81
  End Sub
74
82
 
75
83
  ```

1

コード追記

2020/10/28 03:22

投稿

hatena19
hatena19

スコア33742

test CHANGED
@@ -31,3 +31,45 @@
31
31
 
32
32
 
33
33
  念のためにバックアップを取ってから作業をしてください。
34
+
35
+
36
+
37
+ ---
38
+
39
+
40
+
41
+ 作業列とオートフィルターを使って削除する場合のコード例
42
+
43
+
44
+
45
+ ```vba
46
+
47
+ Sub Sample1()
48
+
49
+ Dim tbl As Range
50
+
51
+ Set tbl = Range("A1").CurrentRegion '表範囲取得
52
+
53
+ Set tbl = tbl.Resize(tbl.Rows.Count, tbl.Columns.Count + 1) '作業列追加
54
+
55
+
56
+
57
+ Dim workCol As Range '作業列の式を設定する範囲
58
+
59
+ Set workCol = tbl.Columns(tbl.Columns.Count).Offset(2).Resize(tbl.Rows.Count - 2, 1)
60
+
61
+ workCol.Formula = "=IF(AND(A2=A3,B2=B3,D3=""未確定"",D2=""確定"",C3<=C2),1,0)"
62
+
63
+
64
+
65
+ tbl.AutoFilter Field:=6, Criteria1:="1"
66
+
67
+ tbl.Offset(1).EntireRow.Delete
68
+
69
+ tbl.AutoFilter
70
+
71
+ workCol.Clear
72
+
73
+ End Sub
74
+
75
+ ```