rapor yazan sayfaya veri aktarma

[Emine Şahin]

arkadaşlar ekteki dosyada veri sayfasındaki verileri rapor yazan sayfaya nasıl aktarabiliriz. bo rapor sayfasındaki form bozulmamalı. veri sayfasındaki veriler birkaç kez girilmiş olabilir. aynı verilerde değerlendirilmeli ve sürekli veri girişi olacağı için bu verileri girerken yada bir buton yardımıyla güncellenebilirmi. ilginize wteşk ed.

 

[Necdet]

veri sayfasındaki veriler birkaç kez girilmiş olabilir. aynı verilerde değerlendirilmeli

Nasıl değerlendirilmeli? biraz açmalısınız bu sözcüğü

 

[Emine Şahin]

nasıl anlatsam ki

Nasıl değerlendirilmeli? biraz açmalısınız bu sözcüğü

şöyle anlatayım... günlük gelen araçların geirdiği yabancı tüpler var. veri sayfasına bunları giriyorum yada basit bir ifade ile veri sayfasında listeliyorum. sonra bu listeyi rapor sayfasında buluna tabloya, tablo bozulmadan ve tablonun istediği değerleri aktarmak istiyorum. burda şu varki bir abonemiz bir ay içerisinde birkaç kez veri girişi yapılmış olabilir yada farklı yabancı tüpler almış olabilir burada önemli olan tüp sayısı toplamı, eğer iki farklı yabancı tüp yada üç farklı tüp olsada bu markalardan biri raporda olabilir. hangisinin olduğu önemli değil... anlatabildiysem ne mutlu...

 

[Emine Şahin]

Kİmse Yokmu Şİmdİ

arkadaşlar tam 25 kişi bakmış kimse bi şeymi anlamadı benmi anlatamadım anlamış değilim...


hu huuuuuu kimse yok muuuuu ????

 

[Ferhat Pazarçevirdi]

Aşağıdaki kodu Standart bir modül sayfasına kopyalayarak çalıştırınız.

Sub deneme()
Set shv = Sheets("VERİ")
Set shr = Sheets("RAPOR")
sonv = shv.Cells(65536, 1).End(xlUp).Row
For i = 4 To sonv
    x = Application.WorksheetFunction.CountIf(shv.Range("D4:D" & i), shv.Cells(i, 4))
    If x = 1 Then
       For Each hcr In shr.Range("A:A")
           If hcr.Value <> Empty And hcr.Offset(0, 1).Value = Empty Then
              hcr.Offset(0, 1).Value = shv.Cells(i, 4)
              hcr.Offset(0, 2).Value = shv.Cells(i, 5)
              hcr.Offset(0, 3).Value = shv.Cells(i, 6)
              For j = 4 To sonv
                  If hcr.Offset(0, 1) = shv.Cells(j, 4) Then
                     toplam = toplam + shv.Cells(j, 3)
                  End If
              Next j
              hcr.Offset(0, 4) = toplam
              toplam = 0
              GoTo f1
           End If
       Next
    End If
f1:
Next i
Set shv = Nothing
Set shr = Nothing
End Sub

 

[Emine Şahin]

TeŞekkÜr

Çok TeŞekkÜr Edİyorum. GerÇekten Harİkasiniz. Tam İstedĞİm Bİ Kod OlmuŞ... Bende Bİ ÖĞrenebİlseydİm Kod Yazmayi...

 

[Ferhat Pazarçevirdi]

Rica ederim. Kolay gelsin.

 

[Emine Şahin]

bir problem var sanırım. bu belgeyi her zaman kullanacağım içim denemk için veri sayfasından verilerin çoğunu sildim, tekrar rapor al dediğim zaman daha önce almış olduğu raporun devamına yenileri ekliyo. ben ne zaman rapor al dersem verileri her defasında yeniden hesaplaması mümkün değilmi ?...

 

[Ferhat Pazarçevirdi]

Kodlarınızı aşağıdaki gibi revize ediniz.

Sub deneme()
Set shv = Sheets("VERİ")
Set shr = Sheets("RAPOR")
sonv = shv.Cells(65536, 1).End(xlUp).Row
[COLOR=red]sonr = shr.Cells(65536, 1).End(xlUp).Row
For Each hcr In shr.Range("A:A")
    If hcr.Row = sonr + 1 Then GoTo f2
    If hcr.Value <> Empty And hcr.Offset(0, 1).Value <> Empty Then
       hcr.Offset(0, 1).Value = Empty
       hcr.Offset(0, 2).Value = Empty
       hcr.Offset(0, 3).Value = Empty
       hcr.Offset(0, 4).Value = Empty
    End If
Next
f2:
[/COLOR]For i = 4 To sonv
    x = Application.WorksheetFunction.CountIf(shv.Range("D4:D" & i), shv.Cells(i, 4))
    If x = 1 Then
       For Each hcr In shr.Range("A:A")
           If hcr.Value <> Empty And hcr.Offset(0, 1).Value = Empty Then
              hcr.Offset(0, 1).Value = shv.Cells(i, 4)
              hcr.Offset(0, 2).Value = shv.Cells(i, 5)
              hcr.Offset(0, 3).Value = shv.Cells(i, 6)
              For j = 4 To sonv
                  If hcr.Offset(0, 1) = shv.Cells(j, 4) Then
                     toplam = toplam + shv.Cells(j, 3)
                  End If
              Next j
              hcr.Offset(0, 4) = toplam
              toplam = 0
              GoTo f1
           End If
       Next
    End If
f1:
Next i
shr.Select
Set shv = Nothing
Set shr = Nothing
End Sub

 

[Emine Şahin]

tamam şimdi oldu
çok teşekkür ederim. allah razı olsun yaaa sizden..