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

5 hits

▼

【36865】アンマッチの一覧表作成 YBA 06/4/17(月) 9:28