Dakikalık bir tablodan saat başlarını çekmek

[clayman]

Merhaba arkadaşlar elimde bir tablo var ve ben bu tablodan bazı verileri çekmek istiyorum fakat başaramadım.

Tablo dakikalık verilerden oluşan bir tablo. Örneği incelerseniz gayet açık bir şekilde anlaşılıyor. Bana bu tablodan saat başlarını çeken bir formül lazım. Fakat bazı saat başlarına karşılık gelen veriler yok dolayısıyla bu hücrelerin yeni tabloda boş kalması gerekiyor.

Yardımcı olursanız çok sevinirim. Örnek dosya ekte.

 

[Necdet]

Merhaba
Tam anlamadım ama sanırım saati çekmek istiyorsunuz.

=HOUR(B2
=SAAT(B2))

Makroyla :

Sub Saatler()
For i = 2 To [A65536].End(3).Row
    Cells(i, "D") = DatePart("h", Cells(i, "B"))
Next i
End Sub

 

[clayman]

yok ben hazırladığım tabloda o saatbaşlarının bulunduğu satırlardaki x verisini çekmek istiyorum. Örnek olarak gönderdiğim tabloyu incelerseniz daha kolay anlaşılır. Çok teşekkür ederim ilgilendiğiniz için.

 

[Necdet]

O tablodan birşey anlamadım. Mesajınızdan da saati çekeceğinizi anladım.

 

[clayman]

O zaman şöyle izah edeyim,

Orjinal tablo A B ve C stünlarından oluşuyor. Bu sütunlarda;
A Sütunu : Tarih
B Sütunu : Saat ( 00:00, 00:01, 00:02, 00:03, ... , 23:59 )
C Sütunu : X verileri

Benim İstediğim Tablo ise:

H Sütunu : Tarih
I Sütunu : Saat Başları ( 00:00, 01:00, 02:00, .. , 23:00 )
J Sütunu : X verileri

Şimdi orjinal tabloda bu veriler ( X verileri ) dakikalık olarak deişiyor. ( 00:00, 00:01, 00:02, 00:03, ... , 23:59 )
Bana ise bu verilerin ( X verileri ) Saat başlarına denk gelen satırlardaki değerleri lazım ( 00:00, 01:00, 02:00, .. , 23:00 )
Bunu yapacak bi makro yada formül varmı? varsa örnek verebilirmisiniz?

 

[Necdet]

Merhaba,

Olay şimdi anlaşılmıştır.

Makro ile çözüm :

Sub SaatBasiVeriler()
Dim i, j As Long
j = 1
Application.ScreenUpdating = False
Range("H2:J65536").ClearContents
For i = 2 To [A65536].End(3).Row
    If Minute(Cells(i, "B")) = 0 Then
        j = j + 1
        Cells(j, "H") = Cells(i, "A")
        Cells(j, "I") = Cells(i, "B")
        Cells(j, "J") = Round(Cells(i, "C"), 2)
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem Tamam..."
End Sub

 

[clayman]

üstadım ellerine sağlık peki bu makroda 01:00 dan başlıyor benim bunu 00:00 saatlerinide almam mümkün mü?

 

[Necdet]

Alması gerek, ben saati değil dakikayı dikkate aldım. Dakika Sıfır ise listeliyor.

 

[clayman]

peki mesela 05:00 saatine ait satır yok ama yeni tabloda bu satırın olması ve boş kalması lazım. Bunu nasıl yapabilirim. kusura bakmayın size zahmet oluo ama çok işime yarıcak bu macro

 

[Necdet]

Merhaba,

Olayı şimdi anladım. Eksik veri olduğunda da siz gelsin istiyorsunuz.
Bu durumda kodları değiştirmek gerek, ama şu an müsait değilim, bir arkadaş ilgilenirse sevinirim, yoksa boş bir zamanımda bakarım.

 

[clayman]

teşekkür ederim yrn boş zamanınız olurda ilgilenirseniz yada bu akşam gerçekten çok sevinirim iyi akşamlar

 

[Necdet]

Merhaba,

Kodları dener misiniz?

Sub SaatBasiVeriler()
Dim i, j As Long
j = 1
Application.ScreenUpdating = False
With Range("H2:J65536")
    .ClearContents
    .Interior.ColorIndex = xlNone
    .Font.Bold = False
End With
For i = 2 To [A65536].End(3).Row
    If Minute(Cells(i, "B")) = 0 Then
        j = j + 1
        Cells(j, "H") = Cells(i, "A")
        Cells(j, "I") = Cells(i, "B")
        Cells(j, "J") = Round(Cells(i, "C"), 2)
    End If
Next i
For i = [H65536].End(3).Row To 3 Step -1
    If Hour(Cells(i, "I") - Cells(i - 1, "I")) <> 1 Then
        Range("H" & i & ":J" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Cells(i, "I") = TimeSerial(Hour(Cells(i - 1, "I")) + 1, 0, 0)
        If Hour(Cells(i, "I")) = 0 Then
            Cells(i, "H") = Cells(i - 1, "H") + 1
        Else
            Cells(i, "H") = Cells(i - 1, "H")
        End If
        Range("H" & i & ":J" & i).Interior.ColorIndex = 16
    End If
Next i
Do While Hour(Cells(i, "I")) <> 0
    Range("H" & i & ":J" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Cells(i, "I") = TimeSerial(Hour(Cells(i + 1, "I")) - 1, 0, 0)
    Cells(i, "H") = Cells(i + 1, "H")
    Range("H" & i & ":J" & i).Interior.ColorIndex = 16
Loop
Application.ScreenUpdating = True
MsgBox "İşlem Tamam...  "
End Sub

 

[clayman]

Necdet bey çok teşekkür ederim. Ellerinize sağlık tam işime yarayan bi macro olmuş. Çok teşekkür ederim.

 

[Necdet]

Güle güle kullanınız.