| |
逆でしたね！！
>例えば、・・・
>シート２には、
> Ａ Ｂ
>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 shtrng1 Is Nothing Then
If Not shtrng2 Is Nothing Then
shtrng2.EntireRow.Delete
End If
Else
If Not shtrng2 Is Nothing Then
For Each crng In shtrng2
If find_rng(crng, shtrng1) = 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()を実行してみて下さい。
|
|
ichinose
- 03/7/31(木) 8:05 -
