| |
こんにちは
条件ファイルはSheet1のみとします。（このファイルに下記のコードを記載する）
条件ファイルSheet1の記載方法
条件は下記ように正確に記載
条件は1行目より始まる
A B C
1 A列の条件 B列の条件 M列の条件 →データファイルの該当シートの列
2
3
以降続く(100件)
データファイルのシートはSheet1としています
更に実データは2行目からで1行目は項目行とします。
IV列を作業列して使います。
では下記のコードを条件ファイルの標準モジュールにて記載して下さい。
実行にあたって
条件ファイルと、データファイルが開いている事（それ以上開いている場合は処理しません）
ではお試しを。
Sub Test()
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("A1", .Range("A65536").End(xlUp)).Offset(, 255)
.Formula = "=CONCATENATE(A1,B1,C1)"
.Value = .Value
Set R = .Offset(0)
End With
End With
With Ws.Range("A2", Ws.Range("A65536").End(xlUp))
.Offset(, 255).Formula = "=CONCATENATE(A2,B2,M2)"
.Offset(, 255).Value = .Offset(, 255).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 = "○"
Loop Until Ad = Fi.Address
Set Fi = Nothing
End If
Next C
.Offset(, 255).Clear
On Error Resume Next
.Offset(, 13).SpecialCells(xlCellTypeBlanks).Value = "×"
On Error GoTo 0
End With
R.Clear
Set Ws = Nothing: Set R = Nothing
End Sub
|
|
Statis
- 06/5/11(木) 16:23 -
