|
逆でしたね!!
>例えば、・・・
>シート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)
Set shtrng1 = get_rng(Worksheets("シート1"), 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()を実行してみて下さい。
|
|