回答編集履歴

2

コード追加

2021/12/02 02:00

投稿

hatena19
hatena19

スコア34075

test CHANGED
@@ -49,3 +49,59 @@
49
49
  If Not delR Is Nothing Then delR.Delete
50
50
 
51
51
  ```
52
+
53
+
54
+
55
+ ---
56
+
57
+
58
+
59
+ **フィルターをかけて、非表示になった行を削除、その後フィルターを解除**
60
+
61
+
62
+
63
+ ```vba
64
+
65
+ Sub Filterdata()
66
+
67
+
68
+
69
+ 'フィルターをかける
70
+
71
+ Dim r As Range
72
+
73
+ Set r = Worksheets("日程").Range("K1")
74
+
75
+ r.AutoFilter Field:=11, _
76
+
77
+ Criteria1:=">=" & worksheets("Sheet1").Range("K5"), _
78
+
79
+ Operator:=xlAnd, _
80
+
81
+ Criteria2:="<=" & worksheets("Sheet1").Range("M5")
82
+
83
+
84
+
85
+ '非表示行の削除
86
+
87
+ Dim i As Long
88
+
89
+ With r.CurrentRegion.EntireRow
90
+
91
+ For i = .Count To 2 Step -1
92
+
93
+ If .Rows(i).Hidden Then .Rows(i).Delete
94
+
95
+ Next
96
+
97
+ End With
98
+
99
+
100
+
101
+ 'フィルター解除
102
+
103
+ r.AutoFilter
104
+
105
+ End Sub
106
+
107
+ ```

1

説明追記

2021/12/02 02:00

投稿

hatena19
hatena19

スコア34075

test CHANGED
@@ -1,3 +1,7 @@
1
+ 削除するときは後ろから削除しないとうまくいかない。(削除すことによって後の行が前に移動するため)
2
+
3
+
4
+
1
5
  ```vba
2
6
 
3
7
  Dim i As Long
@@ -13,3 +17,35 @@
13
17
  End With
14
18
 
15
19
  ```
20
+
21
+
22
+
23
+ あるいは、Unionでまとめて一気に削除するかですね。
24
+
25
+
26
+
27
+ ```vba
28
+
29
+ Dim R As Range, delR As Range
30
+
31
+ For Each R In Range("A1").CurrentRegion.EntireRow
32
+
33
+ If R.Hidden Then
34
+
35
+ If delR Is Nothing Then
36
+
37
+ Set delR = R
38
+
39
+ Else
40
+
41
+ Set delR = Union(delR, R)
42
+
43
+ End If
44
+
45
+ End If
46
+
47
+ Next
48
+
49
+ If Not delR Is Nothing Then delR.Delete
50
+
51
+ ```