| |
インデントとコメントを付けて見ました
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
|
|
Hirofumi
- 11/1/8(土) 9:14 -
