• DİKKAT

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

Dolu hücreleri saymak

C

cebelitarık

Katılım
12 Kasım 2007
Mesajlar
327
Excel Vers. ve Dili
excel 2003
Forumun değerli üyeleri

Herhangi bir satırda
B sütunu doluysa A sütununa 1 yazsın.
B sutunu ve D sutunu doluysa A sütununa 2 yazsın.
B sütunu ve D sutunu ve H sutunu doluysa A sütununa 3 yazsın istiyorum.
Sutunlar belirli bir dizinde değildir.
ilgili sutunlardaki değerler silindikçe de değerler otomatik olarak hesaplansın.
B,D ve H sutunu dışındaki hücrelerde yapılan işlemlerde kod çalışmasın.
Buna ait kod nasıl yzılabilir?
Saygılarımla
 
merhaba
bu söylediğiniz sütunlar'ın tamamı mı dolacak yoksa 1 hücre dolduğunda mı sayım yapacak.
bunu nasıl belirleyeceğiz bir örnek dosya eklemek zor mu_? bu kadar
 
Syın İhsan Tank
İlginize teşekkür ederim.
Örnek dosya ekledim.
B, D, ve H sütunlarındaki hücreler doldukça anında hesaplama yapılacak.
B sutunundaki hücre doldurulmadan D sutunu doldurulursa B sutunun doldurulmadığı uyarısı verilecek. B,D ve H sutunları sırayla doldurulursa hata mesajı verilmeyecektir.
Saygılarımla
 

Ekli dosyalar

cebelitarık' Alıntı:
Syın İhsan Tank
İlginize teşekkür ederim.
Örnek dosya ekledim.
B, D, ve H sütunlarındaki hücreler doldukça anında hesaplama yapılacak.
B sutunundaki hücre doldurulmadan D sutunu doldurulursa B sutunun doldurulmadığı uyarısı verilecek. B,D ve H sutunları sırayla doldurulursa hata mesajı verilmeyecektir.
Saygılarımla
Genişletmek için tıkla ...

tüm sorularınızın cevabı burada
dosyayı inceleyiniz.
veri - doğrulama - özel seçeneği engellemek için kullanılmıştır.
saydırmak için ise makro kullanılmıştır. Say butonuna basınız
 

Ekli dosyalar

Sayın İhsan Tank
Teşekkür edrim
Ancak kodu ben change olayında kullanmak istiyorum.
kodu change olayına uyguladığımda da bilgisayar kiltleniyor.
Bu sorun çözülebilirmi?
Saygılarımla
 
Sayın İhsan Tank
Bu çok hızlı cevabınız içinde çok teşekkür edrim.
Kod işimi gördü fakat bu nu dögü ile değilde target kodu ile yazmak mümkünmüdür.
Aşağıda biraz karalama yaptım.


Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B1:B65536,D1:D65536,H1:H65536")) Is Nothing Then Exit Sub
Dim a As Long

Sheets("Sayfa1").Target("A") = WorksheetFunction.CountA(Target("B"), Target("D"), Target("H"))

End Sub


Bu kodu düzetebilirmiyiz.
saygılarımal
 
bu şekilde yazdığınızda çalışacağını sanmıyorum yada ben bilmiyorum.

umarım diğer arkadaşlar yardımcı olurlar benim elimden bu kadarı geliyor
 
Sayın İhsan Tank
Özel Veri Doğrulamayı nasıl girdiniz bir türlü çözemedim.
saygılarımla
 
Selamlar,

Veri doğrulama özelliğini görmek için;

VERİ-DOĞRULAMA menüsünü inceleyiniz.

Ayrıca sayfadaki kodunuzu aşağıdaki şekilde değiştirip deneyiniz.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim X As Long
    If Intersect(Target, Range("B:B,D:D,H:H")) Is Nothing Then Exit Sub
    X = Target.Row
    Cells(X, "A") = WorksheetFunction.CountA(Range("B" & X), Range("D" & X), Range("H" & X))
End Sub
 
Sayın Korhan Ayhan
Çözüm için teşekkür ederim.
Tam istediğim gibi olmuş
Ayrıca veri doğrulama işini de kod içine ilave etmek mümkünmüdür?
Saygılarımla
 
Selamlar,

Aşağıdaki kodu sayfanızın kod bölümüne uygulayıp denermisiniz.


Kod: 
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim X As Long
    
    If Intersect(Target, Range("B:B,D:D,H:H")) Is Nothing Then Exit Sub
    
    On Error GoTo Son
    
    X = Target.Row
    
    Application.EnableEvents = False
    
    If Target.Column = 4 Then
        If Cells(Target.Row, "B") = "" Then
            MsgBox "B" & Target.Row & " hücresini boş geçemezsiniz !", vbCritical
            Target = ""
            Cells(Target.Row, "B").Select
            GoTo Son
            Exit Sub
        End If
    ElseIf Target.Column = 8 Then
        If Cells(Target.Row, "D") = "" Then
            MsgBox "D" & Target.Row & " hücresini boş geçemezsiniz !", vbCritical
            Target = ""
            Cells(Target.Row, "D").Select
            GoTo Son
            Exit Sub
        End If
    End If
 
Son:
    Cells(X, "A") = WorksheetFunction.CountA(Range("B" & X), Range("D" & X), Range("H" & X))
    Application.EnableEvents = True
End Sub
 
Sayın Korhan Ayhan
İlginize teşekkür ederim.
Kodun örnek bir parçası için sormuştum.
Daha sonra gereken kodları kendim ilave ederim diye düşünmüştüm.
Aslında "N" ve "S" sütunları içinde aynı durum gerekiyor.
Yani "B","D","H", sütunları için geçerli durumlar ve uyarılar "N","S" sutunları içinde lazım.
Tüm bu sutunlar sırayla doldurulmayınca hata uyarılarıda aynen verilmesi gerekiyor.
Kendim eklemeye çalıştım ama bir türlü ekleyemedim.
Herhalde siz çözümü IF ELSEIF mantığı üzerine kurduğunuz için ekleyemedim başka bir yolda bulamadım.
Son olarak rica etsem bu konuyu da çözüme kavuşturabilirmiyiz.
Saygılarımla
 
Son düzenleme:
Selamlar,

Aşağıdaki kodu denermisiniz.

Kod: 
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim X As Long
    
    If Intersect(Target, Range("B:B,D:D,H:H,N:N,S:S")) Is Nothing Then Exit Sub
    
    On Error GoTo Son
    
    X = Target.Row
    
    Application.EnableEvents = False
    
    If Target.Column = 4 Then
        If Cells(Target.Row, "B") = "" Then
            MsgBox "B" & Target.Row & " hücresini boş geçemezsiniz !", vbCritical
            Target = ""
            Cells(Target.Row, "B").Select
            GoTo Son
            Exit Sub
        End If
    ElseIf Target.Column = 8 Then
        If Cells(Target.Row, "D") = "" Then
            MsgBox "D" & Target.Row & " hücresini boş geçemezsiniz !", vbCritical
            Target = ""
            Cells(Target.Row, "D").Select
            GoTo Son
            Exit Sub
        End If
    ElseIf Target.Column = 14 Then
        If Cells(Target.Row, "H") = "" Then
            MsgBox "H" & Target.Row & " hücresini boş geçemezsiniz !", vbCritical
            Target = ""
            Cells(Target.Row, "H").Select
            GoTo Son
            Exit Sub
        End If
    ElseIf Target.Column = 19 Then
        If Cells(Target.Row, "N") = "" Then
            MsgBox "N" & Target.Row & " hücresini boş geçemezsiniz !", vbCritical
            Target = ""
            Cells(Target.Row, "N").Select
            GoTo Son
            Exit Sub
        End If
    End If
 
Son:
    Cells(X, "A") = WorksheetFunction.CountA(Range("B" & X), Range("D" & X), Range("H" & X), Range("N" & X), Range("S" & X))
    Application.EnableEvents = True
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst