|
こんにちは
これで如何かな?
Sub Test_Ckeck()
Dim Wb As Workbook, Ws As Worksheet, R As Range, C As Range
Dim Fi As Range, Ad As String, R1 As Range
If Workbooks.Count <> 2 Then Exit Sub
For Each Wb In Workbooks
If Wb.Name <> ThisWorkbook.Name Then
Set Ws = Wb.Worksheets("Sheet1")
Exit For
End If
Next Wb
With ThisWorkbook.Worksheets("Sheet1")
With .Range("A2", .Range("A65536").End(xlUp)).Offset(, 255)
.Formula = "=CONCATENATE(A2,B2,C2,D2)"
.Value = .Value
Set R = .Offset(0)
End With
End With
With Ws.Range("E8", Ws.Range("E65536").End(xlUp))
.Offset(, 251).Formula = "=CONCATENATE(E8,F8,G8,M8)"
.Offset(, 251).Value = .Offset(, 251).Value
Set R1 = .Offset(, 251)
For Each C In R
Set Fi = R1.Find(C.Value, , xlValues, xlWhole)
If Not Fi Is Nothing Then
Ad = Fi.Address
Do
Set Fi = R1.FindNext(Fi)
Fi.Offset(, -242).Value = "○"
Fi.Offset(, -242).Interior.ColorIndex = 34
Loop Until Ad = Fi.Address
Set Fi = Nothing
End If
Next C
.Offset(, 251).Clear
On Error Resume Next
With .Offset(, 9).SpecialCells(xlCellTypeBlanks)
.Value = "×"
.Interior.ColorIndex = 38
End With
On Error GoTo 0
End With
R.Clear
Set Ws = Nothing: Set R = Nothing: Set R1 = Nothing
End Sub
|
|