Sub RemoveDuplicates()
Dim rng As Range
Dim cell As Range
Dim dict As Object
Dim key As Variant
'選択範囲を取得
Set rng = Selection
'辞書オブジェクトを作成
Set dict = CreateObject("Scripting.Dictionary")
'各セルをチェックして、重複している値を削除
For Each cell In rng
If Not dict.exists(cell.Value) Then
dict.Add cell.Value, 1
Else
cell.ClearContents
End If
Next cell
'メモリ解放
Set dict = Nothing
End Sub
上記の excelの vbaについて
Forブロックの内部の
cell.ClearContents
の箇所ですが、そのセルを含む行内部の
ほかの列に値が記入されていない場合は、
その行は消去されるのでしょうか？
↓
ご質問にお答えします。
ご提供いただいたVBAコードでは、
選択範囲内の各セルをチェックし、
辞書オブジェクト(`dict`)に存在しない値を追加します。
既に辞書に存在する値の場合、
そのセルの内容をクリアします (`cell.ClearContents`)。
あなたの質問に関して：
`cell.ClearContents`は
ループ内で処理されているセルの内容だけをクリアします。
したがって、同じ行の他のセルには影響を与えません。
行の他のセルに値が記入されている場合は、
そのまま残ります。
このコードは、選択範囲内の重複したセルの内容をクリアするだけです。
重複が見つかった場合に、
その行の他の列に値が記入されていない場合は行全体を削除したい場合は、
追加のロジックを追加する必要があります。
以下は、重複セルをクリアした後、
その行の他のセルも空であれば行全体を削除するコードです：
```vba
Sub RemoveDuplicates()
Dim rng As Range
Dim cell As Range
Dim dict As Object
Dim key As Variant
Dim rowHasData As Boolean
Dim col As Integer
'選択範囲を取得
Set rng = Selection
'辞書オブジェクトを作成
Set dict = CreateObject("Scripting.Dictionary")
'各セルをチェックして、重複している値を削除
For Each cell In rng
If Not dict.exists(cell.Value) Then
dict.Add cell.Value, 1
Else
cell.ClearContents
' 行全体が空かどうかをチェック
rowHasData = False
For col = 1 To cell.EntireRow.Cells.Count
If Not IsEmpty(cell.EntireRow.Cells(col)) Then
rowHasData = True
Exit For
End If
Next col
' 行が空であれば行を削除
If Not rowHasData Then
cell.EntireRow.Delete
End If
End If
Next cell
'メモリ解放
Set dict = Nothing
End Sub
```
この更新されたコードでは、
重複セルの内容をクリアした後、
同じ行の他のセルにデータがあるかどうかをチェックします。
他のセルにデータがない場合、行全体を削除します。
これにより、求めている動作を実現できるはずです。
コメント
コメントを投稿