シートを比較し、一致した値の行を削除

投稿者 : 初心者     投稿日時 : 2024/08/01(Thu) 11:07:24     OS : 未指定     EXCEL : 未指定

---

AシートのG列に名前があり、BシートもG列に名前があります。
G列は2行でセル結合されています。（G17,18と。次の行はG19,20と続く）
Aシートの名前（G列）とBシートの名前（G列）が一致したら、Bシートの名前（G列）の行を削除したく、
下記コード作成しましたが、一致していない名前まで消えてしましました。
すいませんが、ご教授いただけると幸いです。

Sub 名前重複削除()

Dim ws01 As Worksheet, ws02 As Worksheet
    Dim i  As Long, j  As Long, lRow  As Long, mRow As Long
    Dim CheckCells As Range
    
    Set ws01 = Worksheets("Aシート")  
    Set ws02 = Worksheets("Bシート")  
    
    lRow = ws01.Cells(Rows.Count, "G").End(xlUp).Row  
    mRow = ws02.Cells(Rows.Count, "G").End(xlUp).Row  
    
    For i = 17 To Cells(Rows.Count, 1).End(xlUp).Row
        For j = 17 To Cells(Rows.Count, 1).End(xlUp).Row
          
            If ws01.Cells(i, "G") = ws02.Cells(j, "G") Then  
               ws02.Rows(j & ":" & j + 1).Delete  
                Exit For       
            End If
        Next j
    Next i
   
End Sub

投稿者 : さんこう     投稿日時 : 2024/08/01(Thu) 11:34:01

---

＞一致していない名前まで消えてしましました。

例えば、AシートのG18セルとBシートのG18セルは、どちらも空欄となっています。

なので、一致して消えます。

投稿者 : てらてら     投稿日時 : 2024/08/01(Thu) 19:58:51

---

こんにちは。

行の削除は、削除するシートのFor文を逆順にしないと上手く行きません。

それと、lRow と mRow を使うべきでしょう。

投稿者 : 初心者     投稿日時 : 2024/08/01(Thu) 21:15:32

---

■[返信 2] てらてらさん（2024-08-01 19:58:51）の記事
＞ こんにちは。
＞
＞ 行の削除は、削除するシートのFor文を逆順にしないと上手く行きません。
＞
＞ それと、lRow と mRow を使うべきでしょう。



すいません。
改善案いただけないでしょうか・・・。
調べていろいろするも全くうまくいかずで。
それと空白の一致は削除しないもご教授いただけると幸いです。
ご無理なら結構です。申し訳ありません。

投稿者 : てらてら     投稿日時 : 2024/08/02(Fri) 07:00:16

---

>調べていろいろするも全くうまくいかずで。

調べてうまく行かない場合は、ひたすら試行錯誤します。（私の場合）

>それと空白の一致は削除しないもご教授いただけると幸いです。

追加の仕様変更は、解答者の負担になるのでやめた方がいいですね。


質問者さんの環境に合うか不明ですが、参考にしてください。

Sub 名前重複削除()

    Dim ws01 As Worksheet, ws02 As Worksheet
    Dim i  As Long, j  As Long, lRow  As Long, mRow As Long
    Dim CheckCells As Range
    
    Set ws01 = Worksheets("Aシート")
    Set ws02 = Worksheets("Bシート")
    
    lRow = ws01.Cells(Rows.Count, "G").End(xlUp).Row
    mRow = ws02.Cells(Rows.Count, "G").End(xlUp).Row
    
    'For i = 17 To Cells(Rows.Count, 1).End(xlUp).Row   <==Cellsから書き始めらたダメ
    '    For j = 17 To Cells(Rows.Count, 1).End(xlUp).Row  <==Cellsから書き始めらたダメ
    For i = lRow To 17 Step -2
        For j = mRow To 17 Step -2
          
            If ws01.Cells(i, "G") = ws02.Cells(j, "G") And ws01.Cells(i, "G") <> "" Then
                ws02.Rows(j + 1 & ":" & j).Delete
                Exit For
            End If
        Next j
    Next i
   
End Sub

投稿者 : 初心者     投稿日時 : 2024/08/02(Fri) 07:26:59

---

てらてら様、ありがとうございます。