[Yardım]  Countifs(Çokeğersay) kodunu dictionarye çevirme.

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Countifs(Çokeğersay) kodunu dictionarye çevirme.

İleti#1)  feraz » 07 Haz 2018 04:22

Merhaba.

Alttaki kodu CreateObject("System.collections.arraylist") yada scripting.dictionary koduna nasıl çevrilir.
CreateObject("System.collections.arraylist") ile olursa çok makbule geçer.
Çevirtmekteki amacım fazla satır olunca yavaş çalışıyor.

Saygılar.

Kod: Tümünü seç
Private Sub CommandButton1_Click()

    Dim i As Long, son As Long

    Application.ScreenUpdating = False
    With Sheets("Sayfa1")
        son = .Range("A" & Rows.Count).End(3).Row
        .Range("C2:C" & Rows.Count).ClearContents
        For i = 1 To son
          If WorksheetFunction.CountIfs(.Range("A2:A" & son), .Range("A" & i).Value, .Range("B2:B" & son), .Range("B" & i).Value) > 1 Then _
             .Range("C" & i).Value = "XX"
        Next i
        Application.ScreenUpdating = True
    End With
    i = Empty: son = Empty

End Sub
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5156
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Countifs(Çokeğersay) kodunu dictionarye çevirme.

İleti#2)  Ozan İLGÜN » 07 Haz 2018 12:41

Şuan dosya açamadığım için sizin için basit bir örnek hazırladım. Kendi projenize uyarlayabilirsiniz.
Dictionary kod örneği
Kod: Tümünü seç
Sub kod()
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")

dic.Add "Aşık", "Veysel"
dic.Add "Atilla", "İlhan"
dic.Add "Sunay", "Akın"


MsgBox dic("Aşık")
End Sub

Eğer referanslarınıza Microsoft Scripting Runtime eklerseniz Dim dic As New Scripting.Dictionary şeklinde çağırabilirsiniz.
ozanilgun@mynet.com

Resim
Kullanıcı avatarı
Ozan İLGÜN
Forum Moderatörü
 
Adı Soyadı:Ozan İlgün
Kayıt: 20 Şub 2013 14:43
Konum: İst. Maltepe
Meslek: Arşivist
Yaş: 32
İleti: 2580
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul



Cevap: Countifs(Çokeğersay) kodunu dictionarye çevirme.

İleti#3)  feraz » 07 Haz 2018 12:46

Ozan hocam önce teşekkürler.

Aslında dictionary ve arraylist olaylarını biliyorum lakin countifs e uyarlayamadım ne yaptıysam.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5156
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Cevap: Countifs(Çokeğersay) kodunu dictionarye çevirm

İleti#4)  Ozan İLGÜN » 07 Haz 2018 13:37

feraz yazdı:Ozan hocam önce teşekkürler.

Aslında dictionary ve arraylist olaylarını biliyorum lakin countifs e uyarlayamadım ne yaptıysam.

Ben yanlış anlamışım kusura bakma.
Bu şekilde dene.
Kod: Tümünü seç
Private Sub CommandButton1_Click()
Dim son As Integer
Dim i As Integer
Range("C2:C" & Rows.Count).ClearContents
Application.ScreenUpdating = False
Dim arr As New Scripting.Dictionary
   son = Range("A" & Rows.Count).End(3).Row
    For i = 1 To son
          arr.Add i, Range("A" & i).Value & "#" & Range("B" & i).Value
           
        Next i
         For i = 1 To son
         If Not Benzersiz(arr, Range("A" & i).Value & "#" & Range("B" & i).Value) Then Range("C" & i).Value = "XX"
           Next i
            Application.ScreenUpdating = True
End Sub


Function Benzersiz(Dic As Dictionary, strItem As String) As Boolean
    Dim key As Variant
    Dim i As Integer
    i = 0
    For Each key In Dic.Keys
        If Dic.Item(key) = strItem Then
            'GetKey = CStr(key)
            i = i + 1
            If i > 1 Then
            Benzersiz = False
           
            Exit Function
            End If
        End If
    Next
   Benzersiz = i < 2
End Function
ozanilgun@mynet.com

Resim
Kullanıcı avatarı
Ozan İLGÜN
Forum Moderatörü
 
Adı Soyadı:Ozan İlgün
Kayıt: 20 Şub 2013 14:43
Konum: İst. Maltepe
Meslek: Arşivist
Yaş: 32
İleti: 2580
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul



REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Countifs(Çokeğersay) kodunu dictionarye çevirme.

İleti#5)  feraz » 07 Haz 2018 15:09

Tamam sayın hocam :)

Akşama bir deneyeyim.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5156
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Countifs(Çokeğersay) kodunu dictionarye çevirme.

İleti#6)  feraz » 08 Haz 2018 01:01

Ozan hocam yeni deneyebildim.

Kod tam çalıştı.10000 satırda denedim biraz uyun işlem sürdü.
Daha kısa bir yolu yok mudur?

Vb.net ten sonra Vba dada klasınızı konuşturdunuz :)

Microsoft scripting runtime bu reference den işaretlenmeli bu arada deneyipte hata alıyorumdiyen olursa.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5156
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Countifs(Çokeğersay) kodunu dictionarye çevirme.

İleti#7)  Ozan İLGÜN » 08 Haz 2018 03:36

Daha kısa yapabilir miyim bilmiyorum araştırmam gerek. Yarın biraz bakayım.
ozanilgun@mynet.com

Resim
Kullanıcı avatarı
Ozan İLGÜN
Forum Moderatörü
 
Adı Soyadı:Ozan İlgün
Kayıt: 20 Şub 2013 14:43
Konum: İst. Maltepe
Meslek: Arşivist
Yaş: 32
İleti: 2580
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul



Cevap: Countifs(Çokeğersay) kodunu dictionarye çevirme.

İleti#8)  Ozan İLGÜN » 08 Haz 2018 12:10

Bu nasıl?
Kod: Tümünü seç
Range("C1:C" & Rows.Count).ClearContents
Range("C1:C" & Range("A" & Rows.Count).End(3).Row).Formula = "=If(CountIfs($A$1:$A$12,INDIRECT(ADDRESS(Row(),1)),$B$1:$B$12,INDIRECT(ADDRESS(Row(),2)))=1,"""",""XX"")"



Yada bu?
Kod: Tümünü seç
Dim son As Integer
Dim i As Integer
Dim bulunanindex As Integer
Range("C1:C" & Rows.Count).ClearContents
Application.ScreenUpdating = False

   son = Range("A" & Rows.Count).End(3).Row
    For i = 1 To son
    If Range("D" & i).Value <> "" Then
         bulunanindex = WorksheetFunction.match(Range("D" & i).Value, Range("D1:D" & son), 0)
        If i <> bulunanindex Then Range("C" & i).Value = "XX": Range("C" & bulunanindex).Value = "XX"
          End If
           
        Next i
       Application.ScreenUpdating = True
ozanilgun@mynet.com

Resim
Kullanıcı avatarı
Ozan İLGÜN
Forum Moderatörü
 
Adı Soyadı:Ozan İlgün
Kayıt: 20 Şub 2013 14:43
Konum: İst. Maltepe
Meslek: Arşivist
Yaş: 32
İleti: 2580
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul



Cevap: Cevap: Countifs(Çokeğersay) kodunu dictionarye çevirm

İleti#9)  feraz » 09 Haz 2018 03:25

Ozan İLGÜN yazdı:Bu nasıl?
Kod: Tümünü seç
Range("C1:C" & Rows.Count).ClearContents
Range("C1:C" & Range("A" & Rows.Count).End(3).Row).Formula = "=If(CountIfs($A$1:$A$12,INDIRECT(ADDRESS(Row(),1)),$B$1:$B$12,INDIRECT(ADDRESS(Row(),2)))=1,"""",""XX"")"



Yada bu?
Kod: Tümünü seç
Dim son As Integer
Dim i As Integer
Dim bulunanindex As Integer
Range("C1:C" & Rows.Count).ClearContents
Application.ScreenUpdating = False

   son = Range("A" & Rows.Count).End(3).Row
    For i = 1 To son
    If Range("D" & i).Value <> "" Then
         bulunanindex = WorksheetFunction.match(Range("D" & i).Value, Range("D1:D" & son), 0)
        If i <> bulunanindex Then Range("C" & i).Value = "XX": Range("C" & bulunanindex).Value = "XX"
          End If
           
        Next i
       Application.ScreenUpdating = True


Ozan hocam formül ile alttaki gibi daha kısa kod.Bu arada sizin formüllü kod heralde doğru sonuç vermiyor.

Kod: Tümünü seç
Range("C2:C" & Range("A" & Rows.Count).End(3).Row).Formula = "=IF(COUNTIFS(A:A,A2,B:B,B2)>1,""XX"","""")"
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5156
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Countifs(Çokeğersay) kodunu dictionarye çevirme.

İleti#10)  feraz » 09 Haz 2018 03:31

Kod ise çalışmadı.

Ben redim yada dictionary ile hızlı olursa diye düşünmüştüm.Alttaki kod güzel lakin 10000 satırda yavaş çalışıyor.
Normal döngü 1 den 10000 satıra 1 veya 2 saniye sürüyor lakin işin işine CountIfs girince makina sapıtıyor :)


Kod: Tümünü seç
For i = 1 To son
          If WorksheetFunction.CountIfs(.Range("A2:A" & son), .Range("A" & i).Value, .Range("B2:B" & son), .Range("B" & i).Value) > 1 Then _
             .Range("C" & i).Value = "XX"
   Next i
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5156
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Countifs(Çokeğersay) kodunu dictionarye çevirme.

İleti#11)  Ozan İLGÜN » 10 Haz 2018 00:42

Benden bu kadar. Aklıma başka birşey gelmiyor.
ozanilgun@mynet.com

Resim
Kullanıcı avatarı
Ozan İLGÜN
Forum Moderatörü
 
Adı Soyadı:Ozan İlgün
Kayıt: 20 Şub 2013 14:43
Konum: İst. Maltepe
Meslek: Arşivist
Yaş: 32
İleti: 2580
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul



Cevap: Countifs(Çokeğersay) kodunu dictionarye çevirme.

İleti#12)  feraz » 10 Haz 2018 01:04

Sağol Ozan hocam.

Araştırmalarımdada çözüm bulunmamış.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5156
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: AhrefsBot, Google [Bot] ve 4 misafir

Bumerang - Yazarkafe