Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


74456 / 76738 ←次へ | 前へ→

【6748】Re:シート間の重複チェック訂正
発言  ichinose  - 03/7/31(木) 8:05 -

引用なし
パスワード
   逆でしたね!!

>例えば、・・・
>シート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()を実行してみて下さい。

0 hits

【6745】シート間の重複チェック 中村 03/7/30(水) 17:59 質問
【6747】Re:シート間の重複チェック ichinose 03/7/31(木) 7:43 回答
【6748】Re:シート間の重複チェック訂正 ichinose 03/7/31(木) 8:05 発言
【6750】Re:シート間の重複チェック訂正 中村 03/7/31(木) 8:40 お礼
【6751】シート間の重複チェック再度 中村 03/7/31(木) 9:16 質問
【6752】Re:シート間の重複チェック再度 ichinose 03/7/31(木) 9:25 発言
【6753】ありがとうございました。 中村 03/7/31(木) 10:15 お礼

74456 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free