İki Tarih Arası Raporlama?

[udentr2002]

Merhaba Arkadaşlar bu başlık altındaki bir çok konuyu inceledim ama benim yapmak istediğim biraz daha farklı olduğu için işin içinden çıkamadım Veri sayfasındaki Rapor Al düğmesine tıkaldığımızda gelen foruma tarihleri girip O tarihlerle ilgili olan bazı stünları Rapor sayfasına aldırmak istiyorum. Ekli dosyada da göreceksiniz Veri sayfasında "P" stünundan "AB" stünuna kadar bir çok tarih var P stünundan X stünuna kadar olan veriler 25 derecedeki sıcaklık ortamlarına ait verilerdir. X stünundan AB stünuna kadar olan veriler ise 40 dereceye ait sıcaklık ortamına ait verilerdir.

Kısacası forumda tarihleri girip Rapor al düğmesine tıkladığımızda P stünundan AB stünuna kara olan tarihleri sorgulayıp O tarihlere karşılık gelen stünlardaki verileri rapor sayfasında ilgili yerlere yazacak. Örnekle açıklayacak olursam eğer diyelimki o tarihler arasındaki veri eğer P ile X stünları arasında ise Rapor sayfasındaki Sıcaklık ortamı yazan yere 25 derece yazacak yada tarihler arasındaki veri X ile AB stünları arasında ise sıcaklık ortamı yazan yere 40 derece yazacak vede Rapor sayfasındaki ZAMAN yazan stünda diyelimki tarihler arasındaki veri Q stünunda O zaman Sıcaklık ortamına 25 derece yazacak zaman yazan stünada 6 aylık yazacak ve o tarihler arasında denk gelen tüm verileri alt alta sıralayacak.

Böyle bir şey yapmamız mümkünmü acaba Şimdiden ilgilenen tüm hocalarıma çok teşekkür ederim.

 

[udentr2002]

Dosya açılırken bir hata veriyordu onu düxeltip ekli dosyayı tekrar gönderiyorum. İlgilenen tüm üstatlarıma sonsuz teşekkürlerimi bildirir saygılarımı sunarım

 

[Ferhat Pazarçevirdi]

Aşağıdaki kodu Commandbutton'daki eskilerinin yerine koyup deneyiniz.

Private Sub CommandButton1_Click()
Dim shV As Worksheet
Dim shR As Worksheet
Dim rg As Range
Dim hcr As Range
Set shV = Sheets("Veri")
Set shR = Sheets("Rapor")
shR.Range("A3:J1000").ClearContents
Set rg = shV.Range("P5:AB" & shV.Cells(65536, 2).End(xlUp).Row)
For Each hcr In rg.Cells
    If IsDate(hcr) Then
        If hcr >= DTPicker1 And hcr <= DTPicker2 Then
            Select Case hcr.Column
                Case 16, 17, 18, 19, 20, 21, 22, 23, 24
                    sicaklik = shV.Cells(2, "P")
                Case Else
                    sicaklik = shV.Cells(2, "Y")
            End Select
            z = z + 1
            son = shR.Cells(65536, 1).End(xlUp).Row + 1
            shR.Cells(son, 1) = z
            shR.Cells(son, 2) = shV.Cells(hcr.Row, 2)
            shR.Cells(son, 3) = shV.Cells(hcr.Row, 3)
            shR.Cells(son, 4) = sicaklik
            shR.Cells(son, 5) = shV.Cells(3, hcr.Column)
            shR.Cells(son, 6) = shV.Cells(hcr.Row, "I")
            shR.Cells(son, 7) = shV.Cells(hcr.Row, "M")
            shR.Cells(son, 8) = shV.Cells(hcr.Row, "N")
            shR.Cells(son, 9) = "Gelen rapor ne?"
            shR.Cells(son, 10) = "Kayıt Durumu ne?"
         End If
    End If
Next
shR.Select
Set shV = Nothing
Set shR = Nothing
Set rg = Nothing
Unload Me
End Sub

 

[udentr2002]

Hocam çok ama çok teşekkür ederim ellerinize sağlık Hakkınızı helal edin