Excel VBA質問箱 IV

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

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


44870 / 76732 ←次へ | 前へ→

【36871】Re:アンマッチの一覧表作成
回答  Statis  - 06/4/17(月) 10:46 -

引用なし
パスワード
   こんにちは

こんな感じかな?
(Sheet1=表1 ・ Sheet2=表2)と仮定しています。

Sub Test_1()
Dim C As Range, Fi As Range, R As Range
Dim Ws As Worksheet, Ad As String

Set Ws = Worksheets("Sheet2")
With Worksheets("Sheet1")

   Set R = .Range("A2", .Range("A65536").End(xlUp))
   For Each C In R
     Set Fi = Ws.Columns(1).Find(C.Value, , xlValues, xlWhole)
     If Not Fi Is Nothing Then
      Ad = Fi.Address
      Do
       Set Fi = Ws.Columns(1).Find(Fi)
       If Fi.Offset(, 1).Value = C.Offset(, 1).Value Then
        C.Offset(, 255).Value = 1
        '一致した場合の処理コード
       End If
      Loop Until Ad = Fi.Address
     End If
     Set Fi = Nothing
   Next C
   On Error GoTo End_Len
   R.Offset(, 255).SpecialCells(xlCellTypeBlanks).EntireRow.Copy _
    Ws.Range("A65536").End(xlUp).Offset(1)
   On Error GoTo 0
   Ws.Columns(256).Clear
   R.Offset(, 255).Clear
  
End With

End_Len:
Set R = Nothing: Set Ws = Nothing

End Sub

6 hits

【36865】アンマッチの一覧表作成 YBA 06/4/17(月) 9:28 質問
【36867】Re:アンマッチの一覧表作成 Statis 06/4/17(月) 9:38 発言
【36868】Re:アンマッチの一覧表作成 YBA 06/4/17(月) 9:58 質問
【36871】Re:アンマッチの一覧表作成 Statis 06/4/17(月) 10:46 回答
【36878】Re:アンマッチの一覧表作成 Kein 06/4/17(月) 11:42 回答
【36885】Re:アンマッチの一覧表作成 だるま 06/4/17(月) 13:38 発言
【36892】Re:アンマッチの一覧表作成 YBA 06/4/17(月) 15:32 お礼

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