Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


2471 / 13646 ツリー ←次へ | 前へ→

【67779】異なるデータ行のみ削除する方法 tamura 11/1/7(金) 21:25 質問[未読]
【67785】Re:異なるデータ行のみ削除する方法 Hirofumi 11/1/8(土) 9:14 回答[未読]
【67851】Re:異なるデータ行のみ削除する方法 tamura 11/1/13(木) 10:20 お礼[未読]

【67779】異なるデータ行のみ削除する方法
質問  tamura  - 11/1/7(金) 21:25 -

引用なし
パスワード
   全シートのA列にデータが入っています。
シート1を基準にそれ以外のシートとのセルの照合をして同じものがあった場合はそのままで、異なるものの時だけ、その行を削除するようにしたいのですが、コードを書くと同じものが削除され、反対の動作になってしまいました。修正のポイントを教えてください。
Sub 同じものの列を残す()
Dim i As Integer, k As Integer, m As Integer
m = 0
For i = 2 To Sheets.Count
For m = 1 To Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
With Sheets(i)
For k = .Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
  If .Cells(k, 1).Value = Sheets(1).Cells(m, 1).Value Then
     .Cells(k, 1).EntireRow.Delete
  End If
Next k
End With
Next m
Next i
End Sub

【67785】Re:異なるデータ行のみ削除する方法
回答  Hirofumi  - 11/1/8(土) 9:14 -

引用なし
パスワード
   インデントとコメントを付けて見ました

Option Explicit

Sub 同じものの列を残す()

  'Dim i As Integer, k As Integer, m As Integer
  Dim i As Long, k As Long, m As Long
  
  m = 0
  'シート2〜シート最終まで繰り返し(削除対象シート)
  For i = 2 To Sheets.Count
    'シート1の1行目〜最終行まで繰り返し(基準シート)
    For m = 1 To Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
      '削除対象シートに就いて
      With Sheets(i)
        '削除対象シートの最終行〜1行目まで繰り返し
        For k = .Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
          'もし、削除対象シートのA列k行の値が、基準シートのA列m行の値と同じなら
          If .Cells(k, 1).Value = Sheets(1).Cells(m, 1).Value Then
            '削除対象シートのA列k行を含む行を削除
            .Cells(k, 1).EntireRow.Delete
          End If
        Next k
      End With
    Next m
  Next i
  
End Sub

>異なるものの時だけ、その行を削除するようにしたいのですが、
>コードを書くと同じものが削除され、反対の動作になってしまいました。

此れでは、上記の様に成るのは理解できますよね?
また、基準シートから1セルを取り出して、削除対象シートのセルを比べて行った場合
削除対象シートの最終セルまで比較して行っても、
基準シートセルの値が「有る」、「無い」は解りますが?
削除対象シートセルの値が、基準シートセルの値に含まれるどうかは解りません
人が目で、この作業を行う事を考えますと
削除対象シートから1セル取り出して、基準シートの上から見て行きます
途中で同じ値が有った場合、見るのを辞めます
もし、基準シートの最後まで見て行って該当する値が無い場合、
初めて削除対象シートの値が、基準シートに無いと解ります
因って、この時点で削除対象シートの値が有る行を削除出来ます

詰まり、この方法をコードに当てはめた場合
1、2番目のLoopと3番目のLoopを反対にしなければ成りません
2、3番目のLoopで、セルの値が同じだった場合、Forを抜けます
 この時、Loopを途中で抜けてのか?(同じ値が有った場合)、
 Loopを回り切ったのか?(同じ値が無い場合)の判断を3番目のLoopの直ぐ後で行います
 これには、Flagを使うか、3番目のLoopカウンタを使います
 此処で、Loopを回り切った場合は行削除、途中で抜けた場合は何もしないと言う処理にします

Sub 同じものの列を残す_2()

  'Dim i As Integer, k As Integer, m As Integer
  Dim i As Long, k As Long, m As Long
  Dim lngRowEnd As Long
  
  lngRowEnd = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
  
  'シート2〜シート最終まで繰り返し(削除対象シート)
  For i = 2 To Sheets.Count
    '削除対象シートに就いて
    With Sheets(i)
      '削除対象シートの最終行〜1行目まで繰り返し
      For k = .Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
        'シート1の1行目〜最終行まで繰り返し(基準シート)
        For m = 1 To lngRowEnd
          'もし、削除対象シートのA列k行の値が、基準シートのA列m行の値と同じなら
          If .Cells(k, 1).Value = Sheets(1).Cells(m, 1).Value Then
            Exit For
          End If
        Next m
        'Loopが回り切った場合
        If m > lngRowEnd Then
          '削除対象シートのA列k行を含む行を削除
          .Cells(k, 1).EntireRow.Delete
        End If
      Next k
    End With
  Next i
  
End Sub

【67851】Re:異なるデータ行のみ削除する方法
お礼  tamura  - 11/1/13(木) 10:20 -

引用なし
パスワード
   ▼Hirofumi さん:
御礼が遅くなり、失礼いたしました。
詳しい説明をしていただき、非常に理解が出来ました。
重ねて御礼申し上げます。

2471 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free