disse data vil jeg gerne have over i et ark2 hvor der kun er intervallet xx-xx-xx xx:00 x x intervallet xx-xx-xx xx:15 x x intervallet xx-xx-xx xx:30 x x intervallet xx-xx-xx xx:45 x x
selvfølgelig med værdien for hver føler ved det rigtige tidspunkt.
ark1 bliver automatisk opdateret hvert 5 minut med nye data som overskriver de gamle data.
Og disse i B1:B4 =INDEKS(Ark1!$B$1:$B$1000;SAMMENLIGN(0;MINUT(Ark1!$A$1:$A$1000);0)) =INDEKS(Ark1!$B$1:$B$1000;SAMMENLIGN(15;MINUT(Ark1!$A$1:$A$1000);0)) =INDEKS(Ark1!$B$1:$B$1000;SAMMENLIGN(30;MINUT(Ark1!$A$1:$A$1000);0)) =INDEKS(Ark1!$B$1:$B$1000;SAMMENLIGN(45;MINUT(Ark1!$A$1:$A$1000);0))
Og disse i C1:C4 =INDEKS(Ark1!$C$1:$C$1000;SAMMENLIGN(0;MINUT(Ark1!$A$1:$A$1000);0)) =INDEKS(Ark1!$C$1:$C$1000;SAMMENLIGN(15;MINUT(Ark1!$A$1:$A$1000);0)) =INDEKS(Ark1!$C$1:$C$1000;SAMMENLIGN(30;MINUT(Ark1!$A$1:$A$1000);0)) =INDEKS(Ark1!$C$1:$C$1000;SAMMENLIGN(45;MINUT(Ark1!$A$1:$A$1000);0))
Public Sub Flyt() Dim data As Variant, X As Long, R As Long, I As Integer data = Worksheets("Ark1").Range("A1").CurrentRegion X = 1 With Worksheets("Ark2") For I = 1 To 3 .Cells(X, I) = data(X, I) Next X = X + 1 For R = 2 To UBound(data) If Minute(data(R, 1)) = 0 Or Minute(data(R, 1)) = 15 Or Minute(data(R, 1)) = 30 Or Minute(data(R, 1)) = 45 Then For I = 1 To 3 .Cells(X, I) = data(R, I) Next X = X + 1 End If Next End With End Sub
Sub HentMålinger() On Error Resume Next Set sh1 = Sheets("Ark1") Set sh2 = Sheets("Ark2") rk1 = sh1.Cells(65500, 1).End(xlUp).Row rk2 = sh2.Cells(65500, 1).End(xlUp).Row + 1 sh2.Range("A1:C" & rk2) = "" For t = 1 To rk1 rk2 = sh2.Cells(65500, 1).End(xlUp).Row + 1 k = Minute(sh1.Cells(t, 1)) If k = 0 Or k = 15 Or k = 30 Or k = 45 Then sh1.Range("A" & t & ":C" & t).Copy sh2.Cells(rk2, 1) Next End Sub
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
