| |
こんにちは。
kobasanからちゃんとしたコードが出ているので、
私のは、どうでも良いのですが、
シートレイアウトと、指定したセルが違っているのかもしれません。
こちらでは、きちんと抽出されています。
両シートのセル位置を確認してください。
Sub test()
Dim SH1 As Worksheet, SH2 As Worksheet
Dim myR As Range, myR2 As Range
Dim r As Range, c As Range
’両シートの１行目には、見出しがあるものとしています。
Set SH1 = Worksheets("単価マスタ")
Set SH2 = Worksheets("代価表シート")
Set myR = SH1.Range("A2", SH1.Range("A65536").End(xlUp)) ’A列
Set myR2 = SH2.Range("A2", SH2.Range("A65536").End(xlUp)) ’A列
’代価表シートのA列の２行目から順に
For Each r In myR2
’ｔを０に
t = 0
’単価マスタシートのA列から順に
For Each c In myR
’代価表シートA列の値とマスタシートのA列の値が同じならば、
If r.Value = c.Value Then
’マスタシートのK列の値と代価表シートB列の値がおなじならば、
If c.Offset(0, 10).Value = r.Offset(0, 1).Value Then
’ｔに１をたして、もし、２になれば（同じ組み合わせが、
’２つ以上あれば）、msgを出して、検索をやめる。
t = t + 1
If t > 1 Then
MsgBox "規格" & c.Offset(0, 10).Value & _
"(" & c.Offset(0, 10).Address(0, 0) & ")" & _
vbCrLf & "が重複しています"
Exit For
End If
’ｔが１ならば、代価表シートC列にマスタシートのM列の値を
r.Offset(0, 2).Value = c.Offset(0, 12).Value
’代価表シートE列にマスタシートのN列の値を
r.Offset(0, 4).Value = c.Offset(0, 13).Value
End If
End If
Next
Next
End Sub
|
|
ponpon
- 05/9/10(土) 11:27 -
