Kod'a İlave

[1Al2Ver]

Merhaba,

Aşağıdaki kod'a, bir şart ekleyerek ; "Eğer Sayfa1 B1 = Sayfa4 C2:C ise" ifadesini eklemek istiyorum.

Bir deneme yaptım ama hata aldım,

Sub test() 

Sayfa1.[e2:e49] = ""
s = 1
son = Sayfa4.Cells(Rows.Count, "b").End(xlUp).Row
ReDim veri(1 To son, 1 To 3) As Variant
For satm = 2 To Sayfa4.Cells(Rows.Count, "b").End(xlUp).Row
    If WorksheetFunction.CountIf(Sayfa4.Range("e2:e" & satm), Sayfa4.Cells(satm, "e")) = 1 Then
    [COLOR="SeaGreen"]'If Sayfa4.Range("c2:c") = Sayfa1.[B1] Then[/COLOR]
    If Sayfa4.Cells(satm, "b") >= Sayfa1.[w1] And Sayfa4.Cells(satm, "b") <= Sayfa1.[w2] Then
        veri(s, 1) = Sayfa4.Cells(satm, "e")
        s = s + 1
    End If
    End If
    [COLOR="seagreen"]'End If[/COLOR]
Next
Sayfa1.Range("e2").Resize(s, 3) = veri
End Sub

Teşekkür ederim.

 

[askm]

Range("c2:c") bu şekilde bir ifade kullanamazsınız. Örnek dosyanızı eklerseniz bakalım.

 

[1Al2Ver]

Merhaba,

İlginiz için teşekkür ederim, dosya büyük ve küçültmek zahmetli,

Şayet mümkün ise ,

"Eğer Sayfa1 B1 = ise Sayfa4 C2:C aralığına" şartı nasıl yazılır öğrenmek isterim.

Teşekkür ederim.

 

[askm]

Bir tarafta tek bir hücre diğer tarafta aralık var ve aralığı da tam yazmamışsınız. B1 değerinde ne var. C2:C aralığında ne olması gerek. Toplamlarını mı kıyaslıyorsunuz. Pek anlaşılmıyor.

 

[1Al2Ver]

Tekrar merhaba,

Sayfa1 B1 ve Sayfa4 C2:C aralığı isimlerden oluşuyor,

Örnek ;

Sayfa1, B1 = Ali AYDIN

Sayfa4, C2:C aralığında da kayıtlı isimler var,

C2=Ali AYDIN, C3=Veli MEŞE, C4=Kaan YAZ vb,

Şartımız ; Sayfa4, C2:C aralığındaki isimler, Sayfa1, B1' deki isim ile eşleşirse, diğer şartlar devreye girsin.

Tekrar teşekkür ederim sayın askm.

 

[1Al2Ver]

Konu Günceldir arkadaşlar...

 

[Ziynettin]

Merhaba,

Dosya eklemeden varsayımlı sonuç olur. 50 satırlık örnek dosya eklerseniz bakalım.

 

[Ömer BARAN]

Merhaba.

Örnek belge olmadığından;
-- cevap varsayımlara dayanmak zorunda ve
-- cevabın test edilerek doğruluğunun kontrol edilmesi de mümkün değil
gibi görünüyor.

Belirttiğiniz koşul, For...Next döngüsündeki satır numarasına ilişkin satm değişkeninin aldığı değere göre,
Sayfa4'te ilgili satır C sütunundaki değer Sayfa1'deki B1 hücresine eşitse
şeklinde ise,
aşağıdaki mavi kısmın ilgili satıra eklenmesi halinde sonuç alınması lazım.

Belirttiğim gibi soru afaki, cevap da afaki olmak durumunda.
.

[COLOR="Red"][B]    If Sayfa4.Cells(satm, "b") >= Sayfa1.[w1] And Sayfa4.Cells(satm, "b") <= Sayfa1.[w2] [/B][/COLOR][COLOR="Blue"][B]And Sayfa4.Cells(satm, "C") = Sayfa1.[B1][/B][/COLOR][COLOR="red"][B] Then[/B][/COLOR]

 

[1Al2Ver]

Sayın Ömer BARAN merhaba,

Haklısınız, dosyayı sadeleştirip eklemeye çalışıyorum,

Teşekkür ederim.

 

[1Al2Ver]

Tekrar merhaba,

Örnek dosya ektedir,

Teşekkür ederim.

 

[askm]

Dosyanızın vba kısmı şifreli.

 

[1Al2Ver]

Dosyanızın vba kısmı şifreli.

Sayın askm merhaba,

Uyarınız için teşekkür ederim, gözden kaçmış, vba şifresi kaldırıldı.

 

[askm]

Sub test()

Sayfa1.[e2:e49] = ""
s = 1
Son = Sayfa4.Cells(Rows.Count, "b").End(xlUp).Row
ReDim veri(1 To Son, 1 To 3) As Variant
For satm = 2 To Sayfa4.Cells(Rows.Count, "b").End(xlUp).Row
    If WorksheetFunction.CountIf(Sayfa4.Range("e2:e" & satm), Sayfa4.Cells(satm, "e")) = 1 Then
    If Sayfa4.Range("c" & satm) = Sayfa1.[B1] Then
    If Sayfa4.Cells(satm, "b") >= Sayfa1.[w1] And Sayfa4.Cells(satm, "b") <= Sayfa1.[w2] Then
        veri(s, 1) = Sayfa4.Cells(satm, "e")
        s = s + 1
    End If
    
    End If
    End If
Next
Sayfa1.Range("e2").Resize(s, 3) = veri
End Sub

 

[1Al2Ver]

Sayın askm merhaba,

Kodu kopyaladım, ancak ,

B1'den seçilen bazı isimlere ait (Hasan Dayanır, Suna Çekerek, Mevlüde Tutuş gibi)
Benzersiz Liste oluşmuyor.

Teşekkür ederim.

 

[askm]

Burada countif ile yaparsanız HASAN DAYANIR için örnek verelim. e2 de elbise var. E15 de de elbise olduğu için işlem yapmaz. Yalnız e2 deki elbise Hasan DAYANIRa ait değil. O yuzden countifs kullanmak gerek.

Sub test()

Sayfa1.[e2:e49] = ""
s = 1
Son = Sayfa4.Cells(Rows.Count, "b").End(xlUp).Row
ReDim veri(1 To Son, 1 To 3) As Variant
For satm = 2 To Sayfa4.Cells(Rows.Count, "b").End(xlUp).Row
sayim = WorksheetFunction.CountIfs(Sayfa4.Range("e2:e" & satm), Sayfa4.Cells(satm, "e"), Sayfa4.Range("c2:c" & satm), Sayfa4.Cells(satm, "c"))
    If sayim = 1 Then
    If Sayfa4.Range("c" & satm) = Sayfa1.[B1] Then
    If Sayfa4.Cells(satm, "b") >= Sayfa1.[w1] And Sayfa4.Cells(satm, "b") <= Sayfa1.[w2] Then
        veri(s, 1) = Sayfa4.Cells(satm, "e")
        s = s + 1
    End If
    
    End If
    End If
Next
Sayfa1.Range("e2").Resize(s, 3) = veri
End Sub

 

[1Al2Ver]

Sayın askm, tekrar merhaba,

Zahmetleriniz ve duyarlığınız için bir kez daha teşekkür ederim.

Saygılarımla.

 

[askm]

Rica ederim.

 

[Ömer BARAN]

Merhaba.

Alternatif olsun.
Aşağıdaki kod'u SÜZ sayfasının kod bölümüne yapıştırın.
B1 'deki isim, X1 ve X2'deki yıl ve ay adında değişiklik yaparak sonucu kontrol edin.
.

[B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
If Intersect(Target, [[B][COLOR="blue"]B1[/COLOR][/B], [B][COLOR="blue"]X1[/COLOR][/B], [B][COLOR="Blue"]X2[/COLOR][/B]]) Is Nothing Then Exit Sub
Call [COLOR="Red"][B]test[/B][/COLOR]
[B]End Sub

Sub [COLOR="red"]test()[/COLOR][/B]
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
Set harc = Sheets("HARCAMA_LİSTESİ"): Set s = Sheets("SÜZ")
If s.Cells(Rows.Count, 5).End(3).Row > 1 Then s.[e2:e39] = ""
harc.Range("A1:H1").AutoFilter Field:=3, Criteria1:=s.[B1].Value
harc.Range("A1:H1").AutoFilter Field:=2, _
    Criteria1:=">=" & CLng(s.[W1]), Operator:=xlAnd, Criteria2:="<=" & CLng(s.[W2])
For sat = 2 To harc.Cells(Rows.Count, 5).End(3).Row
    If harc.Rows(sat & ":" & sat).EntireRow.Hidden = False And _
        WorksheetFunction.CountIf(s.Range("E:E"), harc.Cells(sat, 5)) = 0 Then
        s.Cells(s.Cells(Rows.Count, 5).End(3).Row + 1, 5) = harc.Cells(sat, 5)
    End If
Next: harc.AutoFilterMode = False
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
[B]End Sub[/B]

 

[1Al2Ver]

Sayın Ömer BARAN merhaba,

Alternatif çözüm ve duyarlığınız için teşekkür ederim.

Saygılarımla.