高分求谁能帮我编个VB小程序啊

完工。请楼主检查执行结果是否正确。

Sub Calc()

Dim dn As Single

Dim dn1 As Single

Dim i As Integer

Dim j As Integer

Range("A:A").ClearComments

Range("C2:E20000").ClearContents

Range("A:A").NumberFormatLocal = "yyyy-mm-dd hh:mm;@"

If Hour(Right(Cells(3, 1).Text, 5)) <> 0 Or Minute(Right(Cells(3, 1).Text, 5)) <> 0 Then

   Rows(3).EntireRow.Insert

   Cells(3, 1) = DateValue(Left(Cells(4, 1).Text, 10)) & " " & TimeValue("00:00:00")

   dn = 24 - (Hour(TimeValue(Right(Cells(2, 1).Text, 5)) - TimeValue(Right(Cells(4, 1).Text, 5))) + Minute(TimeValue(Right(Cells(2, 1).Text, 5)) - TimeValue(Right(Cells(4, 1).Text, 5))) / 60)

   dn1 = Hour(TimeValue(Right(Cells(4, 1).Text, 5))) + Minute(TimeValue(Right(Cells(4, 1).Text, 5))) / 60

   Cells(3, 2) = Cells(4, 2) - dn1 * (Cells(4, 2) - Cells(2, 2)) / dn

   Cells(3, 1).AddComment Text:="本行数据由 直线插补法 计算而来"

End If

Cells(3, 3) = Hour(TimeValue(Right(Cells(4, 1).Text, 5)) - TimeValue(Right(Cells(3, 1).Text, 5))) + Minute(TimeValue(Right(Cells(4, 1).Text, 5)) - TimeValue(Right(Cells(3, 1).Text, 5))) / 60

Cells(3, 4) = Cells(3, 2) * Cells(3, 3)

j = Range("A65536").End(xlUp).Row

If (Hour(Right(Cells(j, 1).Text, 5)) <> 0 Or Minute(Right(Cells(j, 1).Text, 5)) <> 0) And Left(Cells(j, 1).Text, 10) <> Left(Cells(j - 1, 1).Text, 10) Then

   Rows(j).EntireRow.Insert

   Cells(j, 1) = DateValue(Left(Cells(j + 1, 1).Text, 10)) & " " & TimeValue("00:00:00")

   dn = 24 - (Hour(TimeValue(Right(Cells(j - 1, 1).Text, 5)) - TimeValue(Right(Cells(j + 1, 1).Text, 5))) + Minute(TimeValue(Right(Cells(j - 1, 1).Text, 5)) - TimeValue(Right(Cells(j + 1, 1).Text, 5))) / 60)

   dn1 = Hour(TimeValue(Right(Cells(j + 1, 1).Text, 5))) + Minute(TimeValue(Right(Cells(j + 1, 1).Text, 5))) / 60

   Cells(j, 2) = Cells(j + 1, 2) - dn1 * (Cells(j + 1, 2) - Cells(j - 1, 2)) / dn

   Cells(j, 1).AddComment Text:="本行数据由 直线插补法 计算而来"

Else

   If Hour(Right(Cells(j - 1, 1).Text, 5)) = 0 And Minute(Right(Cells(j - 1, 1).Text, 5)) = 0 And Left(Cells(j, 1).Text, 10) = Left(Cells(j - 1, 1).Text, 10) Then

      j = j - 1

   End If

End If

Cells(j, 3) = 24 - (Hour(TimeValue(Right(Cells(j - 1, 1).Text, 5)) - TimeValue(Right(Cells(j, 1).Text, 5))) + Minute(TimeValue(Right(Cells(j - 1, 1).Text, 5)) - TimeValue(Right(Cells(j, 1).Text, 5))) / 60)

Cells(j, 4) = Cells(j, 2) * Cells(j, 3)

For i = 4 To j - 2

    Cells(i, 3) = Hour(TimeValue(Right(Cells(i + 1, 1).Text, 5)) - TimeValue(Right(Cells(i - 1, 1).Text, 5))) + Minute(TimeValue(Right(Cells(i + 1, 1).Text, 5)) - TimeValue(Right(Cells(i - 1, 1).Text, 5))) / 60

    Cells(i, 4) = Cells(i, 2) * Cells(i, 3)

Next i

Cells(i, 3) = 24 - (Hour(TimeValue(Right(Cells(i - 1, 1).Text, 5)) - TimeValue(Right(Cells(i + 1, 1).Text, 5))) + Minute(TimeValue(Right(Cells(i - 1, 1).Text, 5)) - TimeValue(Right(Cells(i + 1, 1).Text, 5))) / 60)

Cells(i, 4) = Cells(i, 2) * Cells(i, 3)

i = Range("A65536").End(xlUp).Row

Cells(i + 1, 2) = "合计"

Cells(i + 1, 3) = WorksheetFunction.Sum(Range(Cells(3, 3), Cells(j, 3)))

Cells(i + 1, 4) = WorksheetFunction.Sum(Range(Cells(3, 4), Cells(j, 4)))

Range(Cells(3, 5), Cells(10000, 5)).ClearContents

With Range(Cells(3, 5), Cells(j, 5))

     .Merge

     .Value = Int(Cells(i + 1, 4) / Cells(i + 1, 3) * 100) / 100 + (--Right(Int(Cells(i + 1, 4) / Cells(i + 1, 3) * 1000), 1) > 5) * 0.01 + (--Right(Int(Cells(i + 1, 4) / Cells(i + 1, 3) * 1000), 1) = 5) * (--Right(Int(Cells(i + 1, 4) / Cells(i + 1, 3) * 100), 1) Mod 2 = 0) * 0.01

End With

End Sub

执行效果，如下图所示:

关注

http://www.vbgood.com/vbf.good

到这求吧，在百度里很难这么耐心帮你写的！

100分,不够

花M就行了....见我空间