• DİKKAT

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

Koşula göre liste oluşturma

T

turanb

Katılım
18 Mart 2012
Mesajlar
440
Excel Vers. ve Dili
2013
Merhaba,

Ekteki dosyada "Karşılarştırma" rapor sayfasında şu işlemi yapmaktayım;

"Veri" Sayfasının son satırından geriye doğru tarıyarak Plaka sütunundaki Plakaları benzersiz alarak "karşılaştırma" sayfasında bir liste oluşturuyorum.
Ve bu liste ile yine veri sayfasından gerekli verileri seçip karşısına raporlama yapıyorum.

Ancak ihtiyaçtan dolayı şöyle bir şey rica ediyorum.

Yukarıda Plakaları benzersiz listeledikten sonra rapor çekiyorum demiştim.
Şimdi ise Veri sayfasındaki bölge sütunundaki illere göre plakaları benzersiz listelemek istiyorum.

Mesela "Veri" sayfasındaki verilecek tarih aralığına göre "Sivas" ilindeki "plaka"ları "karşılaştırma" sayfasındaki raporun gerekli yerine benzersiz listelesin istiyorum. Sonra listenin devamına diğer illeri aynı şekilde listelemeli.

Yardım rica ediyorum. Anlaşılmayan birşey varsa cevaplayabilirim.
 

Ekli dosyalar

attachment.php


Arkadaşlar resimdekihatayı neden alırım.
 

Ekli dosyalar

  • hata.jpg
    hata.jpg
    19.3 KB · Görüntüleme: 66
Çözümü yazıyım da bari cevapsız kalmasın.

Kod: 
Private Sub CommandButton1_Click()

Range("a2:g2000").ClearContents
Sheets("Veri").Range("C2:D1933").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    
 
  Sheets("Veri").Range("C2:G1933").Copy
  Sheets("Sayfa3").Range("c3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
  Sheets("Veri").ShowAllData
Sheets("Sayfa3").Select

End Sub
 
Rica

Sayın turanb,


Dosyanız çok ilgimi çekti. Dosyanın son şeklini ekler misiniz?

Emek, katkı veren ve paylaşan herkese teşekkürler.

Sevgi ve saygılar.
 
assenucler' Alıntı:
Sayın turanb,


Dosyanız çok ilgimi çekti. Dosyanın son şeklini ekler misiniz?

Emek, katkı veren ve paylaşan herkese teşekkürler.

Sevgi ve saygılar.
Genişletmek için tıkla ...

Teşekkür ederim.

Dosya Firma bünyesinde bulunan araçların Yakıt, litre, yaptığı kilometre, kilometre başına yakıt gibi verileri işleyerek veri tabanı usulü iki farklı raporda sonuçları gösteren bir çalışmadır. Ben 2 yıldır kullanıyorum bu üçüncü yıl. Şu an 2 yıllık verim var üçüncü yıla girdi.

Üstlerimin Farklı bir rapor isteğinden dolayı bir üçüncü rapor sayfası daha eklenecek. Şu an onun için uğraşıyorum. Arkadaşlarım yardım ederde bunu da bitirebilirsem son halini paylaşırım.
 
Size çalışmalarınızda başarılar ve kolaylıklar dilerim.

İnceliğiniz ve bilgilendirmeniz için size, emek ve katkı veren herkese teşekkürler.
 
turanb' Alıntı:
Çözümü yazıyım da bari cevapsız kalmasın.

Kod: 
Private Sub CommandButton1_Click()

Range("a2:g2000").ClearContents
Sheets("Veri").Range("C2:D1933").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    
 
  Sheets("Veri").Range("C2:G1933").Copy
  Sheets("Sayfa3").Range("c3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
  Sheets("Veri").ShowAllData
Sheets("Sayfa3").Select

End Sub
Genişletmek için tıkla ...

Arkadaşlar yukarıdaki koda tarih aralığı ekleyebilir miyiz. Veya Döngü ile farklı şekilde yapabilir miyiz. 2 sütun benzersizi ile ilgili vba kodlu pek yararlı örnekler bulamadım.
 
. . .

Siz Veri sayfasında İl ve Plakaya göre benzersiz liste mi oluşturmak istiyorsunuz.

. . .
 
Hüseyin hocam teşekkür ederim. gönderdiğiniz örneğe baktım.

Benim gönderdiğim kodda 01/01/2014-31/12/2015 arası 112 kayıt listeliyor. Ancak sizin yazdığınız kodda 93 kayıt listeliyor. Bir problem mi var acaba.

Bendeki dosyayı gönderiyorum. Benim yazdığım kodda (makro kaydet yöntemi ile Gelişmiş filtre ile oluşturdum) problemim tarih aralığına göre işlem yapmıyor. bütün veritabanını tarıyor.

Şimdi dikkatimi çekti 2014 verilerini sadece 2 si dışında silmiş olabilir misiniz. Çünkü gönderdiğiniz örnekte 2014 verileri silinmiş görünüyor.
 

Ekli dosyalar

Son düzenleme:
. . .

Denemeler yapmak için veri sayısını azalttım.
Tabloda birim ve plaka sütunları yer değiştirmiş görünüyor.

Yinelenenleri kaldır işlemiyle doğruluğunu test edebilirsiniz.

. . .
 
Hüseyin Çoban' Alıntı:
. . .

Denemeler yapmak için veri sayısını azalttım.
Tabloda birim ve plaka sütunları yer değiştirmiş görünüyor.

Yinelenenleri kaldır işlemiyle doğruluğunu test edebilirsiniz.

. . .
Genişletmek için tıkla ...

Doğru hocam ben Gelişmis filtredeki makroyu uygulayabilmek için yer sütunları yer değiştirmiştim. Onu fark ettim. dediğiniz gibi gelişmiş filtre ile denedim. Sanırım bir problem yok.

Ancak siz modüle yazmışsınız kodları. Button atayıp içine yazsak çalışmaz mı. Denedim hata vermedi ama verileri de yazmadı. Bir fikriniz yada tavsiyeniz var mı?
 
Butona atadiginizda calisir.
Biraz arastirip denemeler yapin.
Yine yapamazsaniz musait oldugumda dosya eklerim.

.
 
Hüseyin Çoban' Alıntı:
Butona atadiginizda calisir.
Biraz arastirip denemeler yapin.
Yine yapamazsaniz musait oldugumda dosya eklerim.

.
Genişletmek için tıkla ...

hocam bütün yazdığının değişkenleri tanımlamamı istiyor.

bunu şu şekilde yapıyoruz dimi.

Dim son,X,t1,t2,aranan,n As integer

Yalnız bu değerlerin hepsi mi integer olacak yoksa sayısal olmayan farklı olan varmı?

Kusura bakmayın sizi meşgul ediyorum. Ama bir haftadır uğraşıyorum. İşin sonuna gelmişken bitireyim diyorum.
 
Hüseyin Çoban' Alıntı:
Kodlari uyguladiginiz son haliyle ekleyin. Inceleyeyim.

.
Genişletmek için tıkla ...

Hocam butona tanımladığım kodlar aşağıdaki gibidir. Tek değiştirdiğim Raporu çektiğim sayfa adı. Butona tıklayınca hiç hata vermiyor ama verileri de listelemiyor. sanki boş tıklıyormuşuz gibi.

Farklı bir sayfada yine buton ekledim. içine kodları yazdım ondada değişkenleri tanımlamamızı istiyor. yukarıda size yazdığım gibi tanımladım. ama bunda da yine tıklayınca hata vermiyor ama sonuç gelmiyor.

Kod: 
Private Sub CommandButton5_Click()
     With Application
        .ScreenUpdating = False: .Calculation = xlCalculationManual: .EnableEvents = False
    End With
    
    Dim SD As Worksheet: Set SD = Sheets("Veri")
    Dim SO As Worksheet: Set SO = Sheets("Karşılaştırma2")
    
    Dim dic As Object, liste(), dizi()
    
    son = SD.Cells(Rows.Count, "C").End(3).Row
    liste = SD.Range("A2:G" & son).Value
    
    ReDim dizi(1 To son, 1 To 7)
    
    
    Set dic = CreateObject("scripting.dictionary")
    
    For X = 1 To UBound(liste, 1)
        
        t1 = liste(X, 2)
        ' MsgBox t1
        t2 = liste(X, 2)
        If t1 >= Range("J1") And t2 <= Range("J2") Then
            aranan = liste(X, 3) & "#" & liste(X, 5)
            
            If Not dic.exists(aranan) Then
                n = n + 1
                dic.Add aranan, n
                ReDim Preserve dizi(1 To son, 1 To 7)
                dizi(n, 1) = liste(X, 1)
                dizi(n, 2) = liste(X, 2)
                dizi(n, 3) = liste(X, 3)
                dizi(n, 4) = liste(X, 4)
                dizi(n, 5) = liste(X, 5)
                dizi(n, 6) = liste(X, 6)
                dizi(n, 7) = liste(X, 7)
            End If
        End If
    Next X
    
  If n = 0 Then GoTo atla
    SO.Range("A:G").Clear
    SO.Range("A1").Resize(dic.Count, 7) = dizi
    SO.Cells.EntireColumn.AutoFit
atla:
    With Application
        .ScreenUpdating = True: .Calculation = xlCalculationAutomatic: .EnableEvents = True
    End With
    
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst