Macro in Excel

[Vebjørn]

Hello

I work on a time series in Excel that should be used in the EPA SWMM. (Storm
water modelling)

Eks of the series:

Date (D/M/Y) Time(H:M) Value (mm)
06/05/2002 00:35 0.2
06/05/2002 02:43 0.2
06/05/2002 03:26 0.2
06/05/2002 03:39 0.2
06/05/2002 04:03 0.2
06/05/2002 04:12 0.2
06/10/2002 01:07 0.2

I need to have values for every minute. Sow i need to insert a row between
the eksisting times. Eks from 00:35 to 02:45 i need 129 rows whit the same
date, one more minute added and the value 0

Eks:
06/05/2002 00:36 0.0
06/10/2002 00:37 0.0

Hope for some answers!!!!

 

[Bob Phillips]

Try

Sub InsertRows()
Dim Lastrow As Long
Dim ThisTS As Date
Dim NextTS As Date
Dim NumRows As Long
Dim i As Long

With ActiveSheet

Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = Lastrow - 1 To 2 Step -1

ThisTS = .Cells(i, "A").Value + .Cells(i, "B").Value
NextTS = .Cells(i + 1, "A").Value + .Cells(i + 1, "B").Value
If NextTS > ThisTS Then

NumRows = Round((NextTS - ThisTS) * 24 * 60, 0)
.Rows(i + 1).Resize(NumRows).Insert
.Cells(i + 1, "A").Resize(NumRows).Value = .Cells(i,
"A").Value
.Cells(i + 1, "B").Value = .Cells(i, "B").Value +
TimeSerial(0, 1, 0)
.Cells(i + 2, "B").Value = .Cells(i, "B").Value +
TimeSerial(0, 2, 0)
.Cells(i + 1, "B").Resize(2).AutoFill .Cells(i + 1,
"B").Resize(NumRows)
.Cells(i + 1, "C").Resize(NumRows).Value = 0
End If
Next i
End With

End Sub

 

[Stefi]

Try this:

Sub insbetw()
Dim oc As Range
loopcount = Range("A" & Rows.Count).End(xlUp).Row - 2
aktsor = 2
For l = 1 To loopcount
Set oc = Range("A" & aktsor)
oc.Select
diff = Round(((Range("A" & oc.Row + 1) + Range("B" & oc.Row + 1)) -
(oc + Range("B" & oc.Row))) * 24 * 60, 0) - 1
Rows(oc.Row + 1 & ":" & oc.Row + diff).Select
Selection.Insert Shift:=xlDown
For i = oc.Row + 1 To oc.Row + diff
Range("A" & i).Value = oc.Value
Range("B" & i).Value = Range("B" & i - 1) + TimeSerial(0, 1, 0)
Range("C" & i).Value = 0
Next i
aktsor = aktsor + diff + 1
Next l
End Sub


--
Regards!
Stefi



„Vebjørn†ezt írta: