|
▼中村 さん:
おはようございます。
>はじめまして、中村と申します。
>早速ですが、どなたかヘルプ願います。
>シート1のA列には見だし〜番号データがバラバラにあります。A列のみにデータあり。
>シート2のA列にも見だし〜番号データがバラバラにあります。B列にもデータあり。
>シート2には全データがあり、シート1にはシート2の一部のデータがあります。
>結果的に、シート2とシート1のA列で重複チェックして、
>シート2はシート1の番号データにマッチした分だけのシートにしたいのです。
>説明不足ですみませんが、宜しくお願いします。
例えば、・・・
シート2には、
A B
1 コード 名称
2 1 A
3 2 B
4 3 C
5 4 D
6 5 E
7 6 F
とデータがあり、シート1には、
A
1 コード
2 1
3 3
4 4
6 7
7 6
とデータがあった場合、シート1でシート2に登録されていない6行目の「7」を
削除したいということでしょうか?
'============================================================
Sub main()
Dim shtrng2 As Range
Dim shtrng1 As Range
Dim crng As Range
Dim delrng As Range
Set shtrng2 = get_rng(Worksheets("シート2"), 1)
'↑シート2のA列のデータ範囲を取得
Set shtrng1 = get_rng(Worksheets("シート1"), 1)
'↑シート1のA列のデータ範囲を取得
If shtrng2 Is Nothing Then 'シート2にデータなし?
If Not shtrng1 Is Nothing Then 'シート1にデータがあった
shtrng1.EntireRow.Delete
End If
Else
If Not shtrng1 Is Nothing Then
For Each crng In shtrng1
If find_rng(crng, shtrng2) = False Then
' ↑シート2に同じデータがあるかチェック
If Not delrng Is Nothing Then
Set delrng = Union(delrng, crng)
Else
Set delrng = crng
End If
End If
Next crng
If Not delrng Is Nothing Then
delrng.EntireRow.Delete
End If
End If
End If
End Sub
'============================================================
Function get_rng(sht As Worksheet, fcol As Long) As Range
With sht
Set get_rng = .Range(.Cells(2, fcol), .Cells(.Rows.Count, fcol).End(xlUp))
End With
If get_rng.Row = 1 Then
Set get_rng = Nothing
End If
End Function
'===========================================================
Function find_rng(rng1 As Range, rng2 As Range) As Boolean
On Error Resume Next
find_rng = True
wk = WorksheetFunction.Match(rng1, rng2, 0)
If Err.Number <> 0 Then find_rng = False
On Error GoTo 0
End Function
でmain()を実行してみて下さい。
|
|