| 
    
     |  | シート1 A    B    C    D    E
 1
 2 2000年    12月1日    15        20
 3    12月12日    20        19
 4    12月12日    20        18
 5 2001年    10月5日    12        17
 6    10月20日    13        16
 15
 14
 13
 12
 11
 10
 で
 下記のソースで動くかやってみてください
 
 Sub TEST()
 Dim InP As String
 Dim OnP As String
 Dim end_row As Long
 Dim s_row As Long
 Dim e_row As Long
 Dim Orow As Long
 Dim DAI As String
 Dim DAI_R As String
 
 Worksheets(1).Select
 end_row = Worksheets(1).Range("B65536").End(xlUp).Row
 
 Worksheets(1).Range("A1").End(xlDown).Select
 s_row = Selection.Row
 DAI = Cells(s_row, 1)
 
 Do While s_row < end_row
 Selection.End(xlDown).Select
 e_row = Selection.Row - 1
 If e_row = 65535 Then e_row = end_row
 
 
 InP = "$C$" & s_row & ":$C$" & e_row
 OnP = "$B$" & 2 + Orow & ":$C$" & 14 + Orow
 DAI_R = "$A$" & 2 + Orow
 Worksheets(2).Range(DAI_R) = DAI
 Application.Run "ATPVBAEN.XLA!Histogram", Worksheets(1).Range(InP), _
 Worksheets(2).Range(OnP), Worksheets(1).Range("$E$2:$E$12"), False, _
 False, False, False
 
 Orow = Orow + 15
 s_row = e_row + 1
 Worksheets(1).Select
 Cells(s_row, 1).Select
 DAI = Cells(s_row, 1)
 Loop
 
 End Sub
 
 |  |