• DİKKAT

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

Koşullu veri sayma

  • Konbuyu başlatan Konbuyu başlatan xlsx
  • Başlangıç tarihi Başlangıç tarihi
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
X

xlsx

Misafir
Selam Arkadaşlar

Forumda daha önce benzer kodların olduğu bir soruda görüp kendi dosyamda da denemiştim.Şuan bu kodlara ulaşamıyorum.
Benim dosyamdaki H sütununda aratacağım malzeme adlarının dosyada belirttiğim koşullara göre adetlerinin saydırılması.
Tamamını formüller ile yapıyorum kusursuz çalışıyor ancak kod ile daha hızlı sonuç vereceğini daha önceki dosyamda tecrübe etmiştim.Yardımınızı beklemekteyim.
 

Ekli dosyalar

Aşağıdaki kodu dener misiniz ?
Kod: 
Sub listele()
For a = 2 To [C65536].End(3).Row
Cells(a, "I").Value = WorksheetFunction.CountIf(Range("C2:C" & [C65536].End(3).Row), Cells(a, "H"))
Next
End Sub
 
eksik bilgi

Dosyadaki verileri 2007den 2003'e aktarırken Comment'ler silinmiş.Açıklayıcı olmadığı için gayet tabi anlaşılmadı.Saydırma ile ilgili koşulların olduğu comment'leri inceleyebilir misiniz tekrar gönderiyorum son hali bu dosyamın.
 

Ekli dosyalar

Arkadaşlar son gönderdiğim dosyada hangi koşullarda saydırma işlemi yapılması gerekiyor, bu bilgiler mevcut.Yardımınızı beklemekteyim
 
Slm
Formülle çalıştırabiliyorum sadece kod bilgisi ile olması gerekiyor.Formülle dosya 65535 veri arasında yavaşlıyor.Kod ile çözüm için yardımınızı rica ederim.
 
Bu formül ile kodlarla bulur.

J2=TOPLA.ÇARPIM(($A$2:$A$1000=J$1)*($B$2:$B$1000=$B2))
 
Selamlar,

Aşağıdaki kodu denermisiniz.

Kod: 
Option Explicit
 
Sub TARİHE_GÖRE_BUL_SAY()
    Dim X As Long
    Dim BUL As Range, ADRES As String
    Dim SÜTUN As Byte
    
    Application.ScreenUpdating = False
    
    [I2:IV65536].ClearContents
    
    For X = 2 To [H65536].End(3).Row
        Set BUL = [C:C].Find(Cells(X, "H"))
        If Not BUL Is Nothing Then
        ADRES = BUL.Address
        Do
        SÜTUN = WorksheetFunction.Match(Cells(BUL.Row, "A"), [J1:IV1], 0) + 9
        Cells(X, SÜTUN) = Cells(X, SÜTUN) + 1
        Cells(X, "I") = WorksheetFunction.Sum(Range("J" & X & ":IV" & X))
        Set BUL = [C:C].FindNext(BUL)
        Loop While Not BUL Is Nothing And BUL.Address <> ADRES
        End If
        Set BUL = Nothing
    Next
        
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Sn Korhan Ayhan
Kod ile denediğimde daha kısa sürüyor elinize sağlık.Sadece son bir isteğim olacak, H sütununda ben yeni bir aranacak kelime girdiğimde formüllü olan dosyamda formülden dolayı anında sonucu görebiliyorum.Ama topla çarpım kullandığım için 65000 veride cok uzun zaman alıyordu.
Kodlara eklemeye çalıştım ancak sonuç vermedi.H sütununa ben aranacak kelime girdikten sonra Enter'la birlikte sayma işlemini otomatik yapmasını istiyorum.Veriyi oradan sildiğimde de sayılanlar silinmeli.Kod bilgimi geliştirmeye çalışıyorum ancak bu konuda yardıma ihtiyacım olacak sanırım.Sayılarak sonucunu aldığım satırlar için tekrar sayma işlemi yapmazsa zaman kaybını da önlemiş olacak.Yardımınızı beklemekteyim.
 
Selamlar,

Aşağıdaki kodu Sayfa1 in kod bölümüne uygulayıp denermisiniz.

Kod: 
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim BUL As Range, ADRES As String, SÜTUN As Byte
    
    If Intersect(Target, [H2:H65536]) Is Nothing Then Exit Sub
    
    On Error GoTo Son
    
    Application.ScreenUpdating = False
    
    If Target <> Empty Then
    
        Range("I" & Target.Row & ":IV" & Target.Row).ClearContents
        
        Set BUL = [C:C].Find(Target)
            If Not BUL Is Nothing Then
            ADRES = BUL.Address
            Do
            SÜTUN = WorksheetFunction.Match(Cells(BUL.Row, "A"), [J1:IV1], 0) + 9
            Cells(Target.Row, SÜTUN) = Cells(Target.Row, SÜTUN) + 1
            Cells(Target.Row, "I") = WorksheetFunction.Sum(Range("J" & Target.Row & ":IV" & Target.Row))
            Set BUL = [C:C].FindNext(BUL)
            Loop While Not BUL Is Nothing And BUL.Address <> ADRES
            End If
        Set BUL = Nothing
        
        MsgBox "İşleminiz tamamlanmıştır.", vbInformation
            
    Else
    
        Range("I" & Target.Row & ":IV" & Target.Row).ClearContents
    
    End If
    
Son: Application.ScreenUpdating = True
End Sub
 

Ekli dosyalar

Slm Korhan Bey, yazdığım formülle sorunsuz çalışıyordu ama kod ile denediğimde daha kullanışlı olduğunu gördüm.Sum.product ile 65binden fazla veride çok yavaşlama oluyordu.Tşk ederim kod bilgisi için.Eklemelerle kendi dosyama ayarladım.
Sadece meraktan soruyorum, H sütununda saydırdığım malzeme adı ve sayısı varken başka bir gün C sütununa yine aynı malzeme girişlerini yazdığımda daha önce arattırdığım H sütunundaki veri adlarına göre malzeme sayhısı da otomatik değişebilir mi?
Yani örneğin C sütununda Kalem girişleri varken H sütununda Kalem yazıp sayısını almıştım.Daha sonra başka birgün C sütununda bu veri girişleri varken yeni Kalem girişlerini satıra eklediğimde H sütununda daha önce saydırdığım Kalem verisinin verileri de otomatik değişebilir mi-?
 
Selamlar,

Bahsettiğiniz işlemin yapılması için H sütununa yazdığınız kelime ile C sütununa yazdığınız kelime aynı olmalıdır.

H sütununa KAL yazıp arama yaptığınızda excele içerir komutu ile arama yaptırabilirsiniz. Fakat C sütununa KALEM yazıp H sütunundaki KAL kelimesini bul demek biraz mantık dışı olmaktadır.

Bunu yapmanın en kolay yolu C sütununa veri girişi yaptığınızda bu veriye karşılık KAL kelimesinin bulunduğu hücreyi seçip F2 + ENTER tuşlarına basarak kodu tekrar çalıştırmaktır.
 
Slm, Tşk bilgilendirmeniz ve kodlar için.Bu haliyle istediğim hızda işlem yapabiliyorum.Kodlar üzerinde yapacağım ufak değişikliklerle kendi dosyama uyarlamam mümkün oldu.Umarım diğer arkadaşlara da faydalı olur.
 
bu iş için pratik bir formul yokmu bende a1 den a100 e kadaar olan listedemail adresi sayısını saydırmak için kaç tane @ var bulmak istiyorum formulü nedir?
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Geri
Üst