| |
こんにちは
条件はすべて記載して下さいと言う事です。
長いや深い、高いがあても問題ないです
ただ、上のセルと同じ値だからと言って「空白」や「同上」や「〃」はNGです。
記入例
A B C
1 項目 項目 項目
2 長い 5mm a
3 長い 5mm b
4 高い 6mm c
5 高い 6mm d
となる
一応、下記でお試しください。
（セルの背景色はそちらの好みに変更して下さい。数値「34」「38」です）
Sub Test_Ckeck()
Dim Wb As Workbook, Ws As Worksheet, R As Range, C As Range
Dim Fi As Range, Ad As String
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("E2", Ws.Range("E65536").End(xlUp))
.Offset(, 251).Formula = "=CONCATENATE(E2,F2,G2,M2)"
.Offset(, 251).Value = .Offset(, 251).Value
For Each C In R
Set Fi = Ws.Columns(256).Find(C.Value, , xlValues, xlWhole)
If Not Fi Is Nothing Then
Ad = Fi.Address
Do
Set Fi = Ws.Columns(256).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
End Sub
|
|
Statis
- 06/5/12(金) 16:04 -
