• DİKKAT

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

Listelemede For-Next Problemi

E

Ergün Güler

Katılım
5 Ocak 2009
Mesajlar
1,586
Excel Vers. ve Dili
2003 Türkçe
Selam,
Kodlarım aşağıdaki gibidir.

Kod: 
Private Sub CommandButton2_Click()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")

son_sat = s1.[a65536].End(3).Row

son_sut = s1.[a1].End(2).Column
s2_son_sat = s2.[D65536].End(3).Row

's2.Range("D4:D" & s2_son_sat).ClearContents

'***********ilk tarih için************
For i = 3 To son_sat
If s1.Cells(i, 1) = s2.Range("A2") Then
ilk = i
End If

Next i
'***********son tarih için************
For j = 3 To son_sat
If s1.Cells(j, 1) = s2.Range("B2") Then
son = j - 1
End If
Next j

For k = 2 To son_sut
For l = ilk To son
For m = 4 To 20

If s1.Cells(l, k) <> "1" Then

s2.Cells(m, 4) = s1.Cells(1, k)
End If
Next
Next
Next

End Sub
yukarıdaki kod ile 2 koşula göre sütunları kontrol edip uygun olanların 1.satırdaki değerlerini başka bir sayfada alt alta listelemek istiyorum. Ancak,
diyelim ki 3 tane sonuç var ise en son sonucu alt alta aynısı sıralıyor.
kısacası aşağıdaki kısmı beceremedim.

Kod: 
For k = 2 To son_sut
For l = ilk To son
For m = 4 To 20

If s1.Cells(l, k) <> "1" Then

s2.Cells(m, 4) = s1.Cells(1, k)
End If
Next
Next
Next
koşula uyan sayfa1'in "k" sütunlarının 1.satırdaki değerlerini sayfa2'nin D sütunundan itibaren alt alta listeleyemedim.
Nasıl yapabilirim?
İyi çalışmalar.
 
Selamlar,

Sorunuzu örnek dosya ile destekleyip yapmak istediğiniz işlemi açıklarmısınız. Anlattıklarınıza göre bana sanki gereksiz döngü kullanıyormuşsunuz gibi geliyor.
 
Örnek dosyam ektedir.
Sayfa2'deki "Ürün Bul" butonuna tıkladığımda, A1 ve A2 tarih aralığındaki Sayfa1'deki "ürün" sütunlara bakacak. hangi ürünün tüm satırlarında "1" yok ise
o ürünün adı (yani 1.satırdaki değeri) sayfa2'nin D4 hücrelesinden itibaren listelenecek.
sayfa1 sarı alanda kontrol edilen yeri belirttim.
sayfa'2nin E sütunda ise mevcut verilere göre olması gereken listeyi belirttim.
Yardımcı olursanız çok sevinirim.
İyi çalışmalar.
 

Ekli dosyalar

Son düzenleme:
Selamlar,

Aşağıdaki kodu denermisiniz. Eksik olduğunu düşündüğünüz kısımlar varsa belirtirseniz düzeltmeye çalışırım.

Kod: 
Option Explicit
 
Private Sub CommandButton2_Click()
    Dim S1 As Worksheet, S2 As Worksheet, WF As WorksheetFunction
    Dim Son_Satır As Long, Satır As Long, Gün_Farkı As Integer
    Dim X As Byte, Say As Integer
 
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    Set WF = WorksheetFunction
    
    Satır = 4
    Son_Satır = S1.Range("A65536").End(3).Row
    
    Application.ScreenUpdating = False
 
    S2.Range("D4:D65536").ClearContents
 
    Gün_Farkı = Day(S2.Range("B2")) - Day(S2.Range("A2")) + 1
 
    For X = 2 To S1.Range("IV1").End(1).Column
        Say = Evaluate("=SUMPRODUCT((" & S1.Name & "!A3:A" & Son_Satır & ">=A2)*(" & S1.Name & "!A3:A" & Son_Satır & "<=B2)*(" & S1.Name & "!" & Cells(3, X).Address & ":" & Cells(Son_Satır, X).Address & "<>1))")
        If Say = Gün_Farkı Then
            If WF.CountIf(S2.Columns(4), S1.Cells(1, X)) = 0 Then
                S2.Cells(Satır, 4) = S1.Cells(1, X)
                Satır = Satır + 1
            End If
        End If
    Next
 
    Set S1 = Nothing
    Set S2 = Nothing
    Set WF = Nothing
 
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Selam Sayın Korhan Ayhan,
Verdiğiniz kodları denedim. Hatalı çalışıyor. Maalesef tüm sonuçları karışık sıra ile görüntülüyor.
örnek dosyamdaki verilere göre sadece 3 tane "Aürün14", Bürün100", "Bürün101" ürün listlenmesi gerekiyor.
Hatalar benim yanlış ifademden kaynaklanıyor.
1.hatayı
S1.Cells(X, 1) >= S2.Range("A2") And S1.Cells(X, 1) <= S2.Range("B2") Then
Genişletmek için tıkla ...
koddaki kırmızı bölümü aşağıdaki gibi değiştirdim.
S1.Cells(X, 1) >= S2.Range("A2") And S1.Cells(X, 1) < S2.Range("B2") Then
Genişletmek için tıkla ...
2.hata şu;
sorgulanan sütunun ilgili aralığındaki tüm hücrelerin tamamı 1'den farklı ise listelensin. herhangi birinde 1 var ise listelenmesin. 1 olmayanlar listelensin istiyorum
aynen örnek dosyamdaki sarı alanlardaki gibi.
3. problem ise şu siz kodlara sayfa2'deki A ve B sütunlarındaki verileri de hesaba katmıssınız.
bunlara gerek yoktu. bu sütunlar ile ilgili "Kayıt" butonuna atadığım ayrıca kodlar ile hesaplama yapıyorum. bunu ayrıca olarak değerlendirelim. sizden şimdilik "Ürün Bul" için çözüm bulabilirseniz sevinirim.
 
Son düzenleme:
Selamlar,

02-01-2010 tarihindeki AÜRÜN3 verisine karşılık gelen hücrede 1 yazmıyor tarih aralığında olmasına rağmen siz bu listelenmesin diyorsunuz sebebi nedir?
 
Selamlar,

#4 nolu mesajımdaki kodu güncelledim. İncelermisiniz.
 
Selam,
5.sıradaki örnek dosyayı yeniden güncelledim.
Çünkü, mesajımı yeniden okursanız anlaycaksınız;
Sorum ile ilgili kısımları da kodlara yazmmışsınız. Yani hiç sormadığım sayfa2'nin A ve B sütunlarını da hesaba katmıssınz. Benim sorumu tam ifade edemeyişimden olsa gerek.

Yeniden yardımcı olursanız sevinirim.
İyi çalışmalar.
 
Son düzenleme:
Selam Sayın Korhan Ayhan,
Kodları aşağıdaki gibi yaparak sonuca ulaştım.
Özellikle kodlardaki "CountIf" ve "satır" mantığını sizden öğrenerek yaptım. Çok Teşekkürler.
5.sıradaki örnek dosyanın Sayfa2'nin kodlarını bir de siz aşağıdaki gibi değiştirip inceleyebilir misiniz?
İyi çalışmalar.

Kod: 
Private Sub CommandButton2_Click()
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")

son_sat = S1.[a65536].End(3).Row
son_sut = S1.[a1].End(2).Column
s2_son_sat = S2.[D65536].End(3).Row

S2.Range("D5:D" & s2_son_sat).ClearContents
'***********ilk tarih için************
For i = 3 To son_sat
If S1.Cells(i, 1) = S2.Range("A2") Then
ilk = i
End If

Next i
'***********son tarih için************
For j = 3 To son_sat
If S1.Cells(j, 1) = S2.Range("B2") Then
son = j - 1
End If
Next j
'***********listelemek için************
satır = 0
For k = 2 To son_sut
If WorksheetFunction.CountIf(S1.Range(S1.Cells(ilk, k), S1.Cells(son, k)), 1) = 0 Then

S2.Cells(satır + 5, 4).Value = S1.Cells(1, k).Value
satır = satır + 1
End If
Next k

End Sub
 
Selamlar,

Sn. Ergün Güler,

Evet sonradan mesajlarınızı okuyunca sorunuzu yanlış yorumladığımı farkettim. Eklediğiniz son dosyanıza göre #4 nolu mesajımdaki kodu güncelledim. Bu şekilde tarihler karışık olsada kod doğru sonucu verecektir. Gerçi siz kendi çabalarınızla sorunu çözümüşsünüz fakat alternatif olması açısından benim önerdiğim koduda inceleyiniz.
 
Selam Sayın Korhan Ayhan,
4.sıradaki kodlarınızı denedim. Çok teşekkür ederim. Tam istediğim gibi.

Say = Evaluate("=SUMPRODUCT((" & S1.Name & "!A3:A" & Son_Satır & ">=A2)*(" & S1.Name & "!A3:A" & Son_Satır & "<=B2)*(" & S1.Name & "!" & Cells(3, X).Address & ":" & Cells(Son_Satır, X).Address & "<>1))")
Genişletmek için tıkla ...

Yukarıdaki kodlara neden ihtiyaç duydunuz?
topla.çarpım fonksiyonunun Makro karşılığı yok mudur?
"Evaluate" ne işe yarıyor? hücre içine fonksiyonları makro kodlarına mı yazılmasını sağlıyor? (örnek "Say" gibi)

Şimdiden çok teşekkürler..
 
Selamlar,

Siz bu değerin ulaştığı sonucu döngü ile buldurmuşsunuz. Satır sayınız az ise döngünün hızını hissetmezsiniz. Yani sonuç hızlı hesaplanıyormuş gibi gelir. Eğer tarih aralığını fazla verip veri satır sayınızıda abartırsanız döngünün sonucu yavaş hesapladığını gözlemleyebilirsiniz. İşte bu aşamada eğer kullanabiliyorsak VBA fonksiyonları çok işimize yarar. Bildiğiniz gibi çok kritere göre işlem sonuçlarını bulmak için genelde TOPLA.ÇARPIM fonksiyonunu kullanıyoruz.

Elbette TOPLA.ÇARPIM fonksiyonunun makro karşılığı vardır. Ben yazım kolaylığından dolayı EVALUATE komutu ile kullanmayı tercih ediyorum. Bununla ilgili olarak aşağıdaki linkte güzel örnekler bulunmaktadır. İnceleyiniz.

Topla.Çarpım (Sumproduct)Fonksiyonunun Vba İçindeki Farklı Kullanımları


EVALUATE komutu VBA içinde kullandığınız formülün sonucunu direkt olarak hesaplamaya yarar. Hesaplanan sonucuda bir değişkene (Say) tanımlayarak kullanabilirsiniz.
 
Selam Sayın Korhan Ayhan,
Açıklamalarınız için çok teşekkürler.
İyi çalışmalar
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst