| |
▼T.K さん：
>以下のようなデータがsheet1にあるとします。
>start end ID
>0 1000 1
>2000 3000 2
>4000 5000 3
>6000 7000 4
>8000 9000 5
>10000 11000 6
>12000 13000 7
>14000 15000 8
>16000 17000 9
>18000 19000 10
>Sheet2において以下のようなデータをセットします。
>start end ID
>20 100
>500 1200
>1500 1800
>2500 3500
>8000 8700
>13500 14000
>15000 15400
>14000 15500
>17500 19000
>5500 7500
>その際ID列に以下のようにsheet1のIDがふられるようにしたいです。
1案ですが、
数値の範囲が重なってるか、外れてるか、調べるのを
セルの範囲が重なってるか、外れてるか、調べることによって
代用したらどうでしょう。
たとえば、 start=20 End=100 という範囲は
[A20:A100]というA列のセル範囲と考えるわけです。
これと調べたいSheet1に書かれた複数範囲と比較するわけです。
含まれるかどうかは Intersectメソッドというのを使います。
（ただし A0 というセルは無いので、もとの数値に +1 した行を
セル範囲として比較します）
Sub test()
Dim CRange() As Range
Dim i As Long, n As Long
Dim v
With Worksheets("Sheet1")
v = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 2).Value
End With
n = UBound(v)
ReDim CRange(1 To n)
For i = 1 To n
Set CRange(i) = Excel.Range("A" & (v(i, 1) + 1), "A" _
& (v(i, 2) + 1))
Next
Dim c As Range
Dim t As Range, x As Range
Dim ok As Long
With Worksheets("Sheet2")
For Each c In .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
Set t = Excel.Range("A" & (c.Value + 1), "A" & _
(c.Offset(, 1).Value + 1))
ok = 0
For i = 1 To n
Set x = Nothing
On Error Resume Next
Set x = Intersect(CRange(i), t)
On Error GoTo 0
If Not x Is Nothing Then
If x.Count = 1 Then
c.Offset(, 2).Value = "ハズレ"
Else
c.Offset(, 2).Value = i
End If
ok = 1
Exit For
End If
Next
If ok = 0 Then
c.Offset(, 2).Value = "ハズレ"
End If
Next
End With
End Sub
|
|
kanabun
- 12/8/15(水) 22:38 -
