| |
▼中村 さん：
おはようございます。
>はじめまして、中村と申します。
>早速ですが、どなたかヘルプ願います。
>シート１のＡ列には見だし〜番号データがバラバラにあります。Ａ列のみにデータあり。
>シート２のＡ列にも見だし〜番号データがバラバラにあります。Ｂ列にもデータあり。
>シート２には全データがあり、シート１にはシート２の一部のデータがあります。
>結果的に、シート２とシート１のＡ列で重複チェックして、
>シート２はシート１の番号データにマッチした分だけのシートにしたいのです。
>説明不足ですみませんが、宜しくお願いします。
例えば、・・・
シート２には、
Ａ Ｂ
1 コード 名称
2 1 Ａ
3 2 Ｂ
4 3 Ｃ
5 4 Ｄ
6 5 Ｅ
7 6 Ｆ
とデータがあり、シート１には、
Ａ
1 コード
2 1
3 3
4 4
6 7
7 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("シート２"), 1)
'↑シート２のＡ列のデータ範囲を取得
Set shtrng1 = get_rng(Worksheets("シート１"), 1)
'↑シート１のＡ列のデータ範囲を取得
If shtrng2 Is Nothing Then 'シート２にデータなし？
If Not shtrng1 Is Nothing Then 'シート１にデータがあった
shtrng1.EntireRow.Delete
End If
Else
If Not shtrng1 Is Nothing Then
For Each crng In shtrng1
If find_rng(crng, shtrng2) = False Then
' ↑シート２に同じデータがあるかチェック
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()を実行してみて下さい。
|
|
- 03/7/31(木) 8:40 -
