• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

veri sıralama

Katılım
8 Kasım 2009
Mesajlar
68
Excel Vers. ve Dili
2003
Ekteki dosyada kayıt sayfasına veriler sayfasındaki bilgilere göre kayıt sayfasındaki b1 ve c1 deki takvimden seçili tarih aralığına göre verileri firmalara ve A sütunundaki verilere göre bir tuşla sıralatmak istiyorum.Selamlarımla.
 

Ekli dosyalar

Ekteki dosyada kayıt sayfasına veriler sayfasındaki bilgilere göre kayıt sayfasındaki b1 ve c1 deki takvimden seçili tarih aralığına göre verileri firmalara ve A sütunundaki verilere göre bir tuşla sıralatmak istiyorum.Selamlarımla.
Dosyanız ektedir.:cool:
Kod:
Sub aktar()
Dim k As Range, j As Byte, i As Long, sat As Long, sh As Worksheet
Dim deg As String, sut As Integer
Sheets("Kayıt").Select
Set sh = Sheets("VERİLER")
Application.ScreenUpdating = False
Range("B5:IV65536").ClearContents
sat = sh.Cells(65536, "A").End(xlUp).Row
sut = Cells(3, 256).End(xlToLeft).Column
For i = 5 To sat
    If sh.Cells(i, "A").Value >= Cells(1, "B").Value And _
    sh.Cells(i, "A").Value <= Cells(1, "C").Value Then
        deg = sh.Cells(i, "D").Value & sh.Cells(i, "B").Value
        Set k = Range("A5:A65536").Find(deg, , xlValues, xlWhole)
        If Not k Is Nothing Then
            For j = 2 To sut Step 2
                If Cells(3, j).Value = sh.Cells(i, "C").Value Then
                    Cells(k.Row, j).Value = sh.Cells(i, "E").Value
                    Cells(k.Row, j + 1).Value = sh.Cells(i, "F").Value
                    Exit For
                End If
            Next j
        End If
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub
 

Ekli dosyalar

Elinize sağlık teşekkür ederim.Ancak aynı firmanın ve aynı tipteki malzemeleri toplaması gerekiyor.B ve C Sütunundaki veriler aynı ise E ve F sütunundaki verileri toplayıp kayıt sayfasında görmek istiyorum.Toplam almadığını sonradan farkettim.
 
Son düzenleme:
Evren bey veriler sayfasındaki verileri toplayarak kayıt sayfasında görümek istemiştim.Oysa bu aynı verileri üst üste toplamadan gösteriyor.Saygılar.
 
Ekteki dosyada kayıt sayfasına veriler sayfasındaki bilgilere göre kayıt sayfasındaki b1 ve c1 deki takvimden seçili tarih aralığına göre verileri firmalara ve A sütunundaki verilere göre bir tuşla sıralatmak istiyorum.Selamlarımla.
Evren bey veriler sayfasındaki verileri toplayarak kayıt sayfasında görümek istemiştim.Oysa bu aynı verileri üst üste toplamadan gösteriyor.Saygılar.
Yukarıdaki sorduğunuz soruda böyle bir ifadeniz yoktu.Bende öyle yaptım.Neysa halledirz.
Sorularınız net ve açık bir biçimde sorarsanız daha doğru yanıtlar alabilirsiniz.Vede hızlı cevaplar alabilirsiniz.:cool:
 
Evren bey veriler sayfasındaki verileri toplayarak kayıt sayfasında görümek istemiştim.Oysa bu aynı verileri üst üste toplamadan gösteriyor.Saygılar.
Dosyanız ektedir.:cool:
Kod:
Sub aktar()
Dim k As Range, j As Byte, i As Long, sat As Long, sh As Worksheet
Dim deg As String, sut As Integer
Sheets("Kayıt").Select
Set sh = Sheets("VERİLER")
Application.ScreenUpdating = False
Range("B5:IV65536").ClearContents
sat = sh.Cells(65536, "A").End(xlUp).Row
sut = Cells(3, 256).End(xlToLeft).Column
For i = 5 To sat
    If sh.Cells(i, "A").Value >= Cells(1, "B").Value And _
    sh.Cells(i, "A").Value <= Cells(1, "C").Value Then
        deg = sh.Cells(i, "D").Value & sh.Cells(i, "B").Value
        Set k = Range("A5:A65536").Find(deg, , xlValues, xlWhole)
        If Not k Is Nothing Then
            For j = 2 To sut Step 2
                If Cells(3, j).Value = sh.Cells(i, "C").Value Then
                    Cells(k.Row, j).Value = Cells(k.Row, j).Value + sh.Cells(i, "E").Value
                    Cells(k.Row, j + 1).Value = Cells(k.Row, j + 1).Value + sh.Cells(i, "F").Value
                    Exit For
                End If
            Next j
        End If
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub
 

Ekli dosyalar

Tekrar teşekkürlerimi iletiyorum.Bu kez tamam,ellerinize sağlık sayın hocam.
 
Geri
Üst