| |
▼jun さん：
こんばんは。
>【sheet1】
> A B C D E
>−−−−−−−−−−−−−−−−−−−−−−
>1.09 1.26 300 L 70
>1.63 2.19 1000 L 95
>2.56 2.91 600 L 95
>3.09 3.40 400 L 80
>3.84 4.20 800 R 95
>4.42 4.75 1000 L 95
>5.05 5.10 600 L 95
>5.31 5.33 370 L 75
このSheet1のＡ列、Ｂ列値が整列されているという条件下で
（例えば、最終行にデータ追加で 10.00 15.00は、Okだけど、
4.76 5.00は駄目）
>
>【sheet2】
> A B
>0
>0.01
>0.02
>・
>・
>・
>1.08
>1.09 70
>1.10 70
>1.11 70
>・
>・
>
>※わからないことがありますのでご教授願います。
> sheet2はA列に0より0.01刻みで94.2まであるとします。
> sheet1は1つの行に対して、A列の数値からB列の数値まではE列の数値であることを示しています。
> そこで、たとえばsheet1において（A列）1.09から（B列）1.26までは（E列）70であるので、sheet2の（A列）1.09から1.26までは（B列）70を入力するマクロを考えたいのです。
>範囲外のところは空欄にします。
'================================================================
Sub main()
Dim s1rng()
Dim s2rng()
Dim ans As Range
Application.ScreenUpdating = False
With Worksheets("sheet1")
ReDim s1rng(1 To .Cells(.Rows.Count, 1).End(xlUp).Row, 1 To 5)
s1rng() = .Range("a1", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 5).Value
End With
With Worksheets("sheet2")
ReDim s2rng(1 To .Cells(.Rows.Count, 1).End(xlUp).Row, 1 To 2)
s2rng = .Range("a1", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 2).Value
Set ans = .Range("a1", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 2)
s2id = 1
s1id = 1
Do While s1id <= UBound(s1rng(), 1) And s2id <= UBound(s2rng(), 1)
f_flg = 0
Do While s2id <= UBound(s2rng(), 1)
If s2rng(s2id, 1) >= s1rng(s1id, 1) And s2rng(s2id, 1) <= s1rng(s1id, 2) Then
s2rng(s2id, 2) = s1rng(s1id, 5)
f_flg = 1
Else
If f_flg = 1 Then Exit Do
s2rng(s2id, 2) = ""
End If
s2id = s2id + 1
Loop
s1id = s1id + 1
Loop
End With
ans.Value = s2rng()
Application.ScreenUpdating = True
End Sub
|
|
