stillfish00

¦^´_ 1# anny8888

1. Sub Test()
   
2.   Dim rIndex As Long, cIndex As Long
   
3.   Dim s, e, p, qs, qe, d
   
4.   
   
5.   With Sheets("Ex1")
   
6.     For rIndex = 6 To .Cells(.Rows.Count, "A").End(xlUp).Row
   
7.       s = .Cells(rIndex, 1).Value
   
8.       e = .Cells(rIndex, 2).Value
   
9.       p = .Cells(rIndex, 3).Value
   
10.       For cIndex = 4 To .Cells(1, .Columns.Count).End(xlToLeft).Column
    
11.         qs = .Cells(1, cIndex)
    
12.         qe = .Cells(2, cIndex)
    
13.         d = Application.Min(e, qe) - Application.Max(s, qs) + 1
    
14.         .Cells(rIndex, cIndex).Value = IIf(d > 0, p * d / (e - s + 1), "")
    
15.       Next
    
16.     Next
    
17.   End With
    
18. End Sub

½Æ»s¥N½X