Şartlı Açıklama Kodu

[seddur]

Merhaba.Aşağıdaki kod ile Anasayfa adlı sayfanın "A" sutununda bulunan açıklamayı Döküm adlı sayfadaki eşleşen satırın F sütununa DOLU diye yazdırmak istiyorum.Ancak -object variable or with block variable not set- şeklinde hata veriyor.Acaba hatayı nerede yapıyorum.Yardımcı olabilirmisiniz.

Dim X As Long
For X = 15 To Sheets("Anasayfa").Cells(Rows.Count, "A").End(3).Row
If Cells(X, "a").Comment.Text = Sheets("Döküm").Cells(X, "a" & b & c & d) Then
Sheets("Döküm").Cells(X, "f") = "DOLU"
End If
Next

 

[seddur]

Örnek dosyayı ekte paylaşıyorum.

 

[ÖmerFaruk]

1. Kodlarınızda Cells(X, "a").Comment.Text kodun çalıştığı Döküm sayfasından veri okumaya çalışıyor.
2. If Cells(X, "a").Comment.Text = Sheets("Döküm").Cells(X, "a" & b & c & d) Then yine bu satırdaki BOLD kısımda hücre başvurunuz hatalı.
3. Herhangi bir Açıklama olan hücredeki değeri siz döküm sayfasında nasıl eşleştirmeye çalışıyorsunuz?
Zira ana sayfada A3 ve A4 hücrelerinizde sadece Açıklama var. Ancak buralarda var oln metin A1Ocak gibi bir formatta. Bunu Döküm sayfanızda A-B-D sütunlarındaki değerlerle eşleştirmeye mi çalışıyorsunuz?
4. Açıklam kısmında kuralsız olrak bir şeyler yazdıysanız Excel ve Kodlar bunu nasıl kurallı yapacaklar?
5. Kodlarınızı For X = 15 To Sheets("Anasayfa").Cells(Rows.Count, "A").End(3).Row satırıyla döngüyü 15.satırdan itibaren başlatmışsınız. Bir sebebi var mı?

 

[seddur]

Anasayfadaki veriler 15.satırdan itibaren başladığı için Döküm sayfasınıda eşleşmesi için 15.satırdan başlattım.Cells(X, "a" & b & c & d) nın açılımının A1OCAK olacağını varsaydım.Eğer A1OCAK döküm sayfasındaki A1OCAK ile eşleşirse ilgili satırın "F" sutununa DOLU yazsın istedim.Ama Cells(X, "a").Comment.Text komutu excel için geçerli bir kod olmadığı anlaşılıyor.Amacım Döküm sayfasında istediğim veriye ulaşabilmek bunun için Anasayfada yapacağım bir işlem ile ulaşmak istediğim verinin satır numarasını getirmekde olabilir, ilk sütunda benzer değerler olduğu için düşeyara da kullanamıyorum.Esas Yapılmak istenen kiraya verilecek dairenin dolu olup olmadığını öğrenmek bunun içinde ilgili sutuna DOLU yazdırmak istedim böylece listview'de süzme yapabileceğim.

 

[ÖmerFaruk]

Sevgili Seddur.
1. AnaSayfadaki verileriniz bize gönderdiğiniz dosyada 1.satırdan başlıyor.
2. .Cells(X, "a" & b & c & d) nın açılımının A1OCAK olacağını varsayımı doğru değil. Sözdiziminiz hatalı
3. Cells(X, "a").Comment.Text ifadesinde bir hata yok. Eğer hücre içinde bir açıklama yoksa bu satır HATA ile sonuçlanır. Bunu gidermek için Hata kontrol denetimi ekleriz ve sorun çözülür.
4. Size önceki mesajımda konular karışmasın diye 5 ayrı maddede açıklama yaptım. Zira siz cevapları karışık şekilde ve metin olarak yazmışsınız. Sorununuza cevap bulmaya çalışıyorum eğer müsade ederseniz.
5. Haliyle bu ve önceki mesajımdaki sorularımın cevaplarını tam verebilirseniz yardımcı olabileceğim.

İyi geceler.

 

[seddur]

Konuyu anlatabilmek adına yazınca metne dönüştü.
1-Doğru size gönderdiğim örnek sonradan yapıldı aceleye geldiği anlaşılıyor.Cells(X, "a").Comment.Text ifadesinde sayfa adını belirtmemişim başına eklemem gerekirdi.
2- Sheets("Döküm").Cells(X, "a" & b & c & d) ifadesi hatalı ise doğrusunu öğrenmek isterim.
3-Sheets("Döküm").Cells(X, "a" & b & c & d) açılımının A1OCAK veya B1ŞUBAT vs.olabileceğini varsaydım. Cells(X, "a").Comment.Text komutunda hata olmamasına sevindim demekki o konuyla uğraşmayıp dediğiniz gibi hata denetimi ekleriz Ben -on error resume next-ifadesini kullanıyorum.
4-Mantık hatası yaptığım anlaşılıyor o zaman satır numarasını baz alarak işlem yaptırsak olmazmı ?
5-Hatalı yazılmış,gözden kaçmış 15 yerine 1 yazılması gerekirdi.

 

[ÖmerFaruk]

Aşağıdaki kodları kullanabilirsiniz

Private Sub CommandButton1_Click()
Dim i As Long, Veri, dict As Object
    On Error Resume Next
    Set dict = CreateObject("Scripting.Dictionary")
    Veri = Range("A2:F" & Cells(Rows.Count, "A").End(3).Row).Value
    Range("F2:F" & Cells(Rows.Count, "A").End(3).Row) = ""
    For i = LBound(Veri, 1) To UBound(Veri, 1)
        dict.Add Veri(i, 1) & Veri(i, 2) & Veri(i, 4), i
    Next i
    For i = 1 To Sheets("Anasayfa").Cells(Rows.Count, "A").End(3).Row
        Acıklama = Sheets("Anasayfa").Range("A" & i).Comment.Text
        If Acıklama <> "" And dict.exists(Acıklama) Then
            Range("F" & dict(Acıklama) + 1) = "DOLU"
        End If
    Next i
    On Error GoTo 0
End Sub

 

[seddur]

Kod için Teşekkürler,çalışıyor.