teratail
回答率
85.47%
質問するログイン新規登録
トップCSVに関する質問キーの重複があった場合にレコードの削除をしたい

編集履歴

回答編集履歴

3

コード修正

2022/10/04 07:40

投稿

hatena19
hatena19

スコア33740

test CHANGED
@@ -1,6 +1,15 @@
1
1
  データ件数が多い重複チェックは連想配列(Dictionary)を使うと高速処理できます。
2
2
 
3
3
  ```vba
4
+ Sub duplicateDelete()
5
+ Application.ScreenUpdating = False
6
+
7
+ Dim rng As Range
8
+ Set rng = Cells(1).CurrentRegion
9
+ Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1, 4) '表のデータ範囲(D列まで)
10
+ Dim ary()
11
+ ary = rng.Value 'データ範囲を配列に
12
+
4
13
  Dim dic As Object
5
14
  Set dic = CreateObject("Scripting.Dictionary")
6
15
 

2

コード修正

2022/10/03 12:01

投稿

hatena19
hatena19

スコア33740

test CHANGED
@@ -1,36 +1,27 @@
1
1
  データ件数が多い重複チェックは連想配列(Dictionary)を使うと高速処理できます。
2
2
 
3
3
  ```vba
4
- Sub duplicateDelete()
5
- Application.ScreenUpdating = False
6
-
7
- Dim rng As Range
8
- Set rng = Worksheets("test").Cells(1).CurrentRegion
9
- Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1, 4) '表のデータ範囲(D列まで)
10
- Dim ary()
11
- ary = rng.Value 'データ範囲を配列に
12
-
13
4
  Dim dic As Object
14
5
  Set dic = CreateObject("Scripting.Dictionary")
15
6
 
16
7
  'C列が〇のIDをDictionaryに登録
17
8
  Dim i As Long
18
- For i = 2 To UBound(ary)
9
+ For i = 1 To UBound(ary)
19
- If ary(i, 3) = "〇" Then dic(ary(i, 1)) = i
10
+ If ary(i, 4) = "〇" Then dic(ary(i, 1)) = i
20
11
  Next
21
12
 
22
13
  'D列が〇でかつIDがDictionaryに存在するときA列を"×"に
23
- For i = 2 To UBound(ary)
14
+ For i = 1 To UBound(ary)
24
- If ary(i, 4) = "〇" Then
15
+ If ary(i, 3) = "〇" Then
25
16
  If dic.Exists(ary(i, 1)) Then ary(i, 1) = "×"
26
17
  End If
27
18
  Next
28
19
  rng.Value = ary '配列をデータ範囲に代入
29
- With Worksheets("test")
20
+
30
- .Cells(1).AutoFilter Field:=1, Criteria1:="×" 'A列が×の行を抽出
21
+ Cells(1).AutoFilter Field:=1, Criteria1:="×" 'A列が×の行を抽出
31
- .Cells(1).CurrentRegion.Offset(1).EntireRow.Delete '行削除
22
+ Cells(1).CurrentRegion.Offset(1).EntireRow.Delete '行削除
32
- .Cells(1).AutoFilter
23
+ Cells(1).AutoFilter
33
- End With
24
+
34
25
  Application.ScreenUpdating = True
35
26
  End Sub
36
27
  ```

1

コード微修正

2022/10/03 11:55

投稿

hatena19
hatena19

スコア33740

test CHANGED
@@ -5,7 +5,7 @@
5
5
  Application.ScreenUpdating = False
6
6
 
7
7
  Dim rng As Range
8
- Set rng = Cells(1).CurrentRegion
8
+ Set rng = Worksheets("test").Cells(1).CurrentRegion
9
9
  Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1, 4) '表のデータ範囲(D列まで)
10
10
  Dim ary()
11
11
  ary = rng.Value 'データ範囲を配列に
@@ -25,12 +25,12 @@
25
25
  If dic.Exists(ary(i, 1)) Then ary(i, 1) = "×"
26
26
  End If
27
27
  Next
28
- Cells(1).CurrentRegion.Resize(, 4).Value = ary '配列をデータ範囲に代入
28
+ rng.Value = ary '配列をデータ範囲に代入
29
-
29
+ With Worksheets("test")
30
- Cells(1).AutoFilter Field:=1, Criteria1:="×" 'A列が×の行を抽出
30
+ .Cells(1).AutoFilter Field:=1, Criteria1:="×" 'A列が×の行を抽出
31
- Cells(1).CurrentRegion.Offset(1).EntireRow.Delete '行削除
31
+ .Cells(1).CurrentRegion.Offset(1).EntireRow.Delete '行削除
32
- Cells(1).AutoFilter
32
+ .Cells(1).AutoFilter
33
-
33
+ End With
34
34
  Application.ScreenUpdating = True
35
35
  End Sub
36
36
  ```