VBA ile EĞERSAY Komutu

[ultraslan38080]

Sayfa1 için
C7 ile C96 arasındaki sayılardan;

0 dan küçük olanların sayısını C97 ye,
0 a eşit olanların sayısını C98 e,
0 dan büyük olanların sayısını C99 a,

yazdıran VBA kodu nasıl yazılır arkadaşlar?

 

[Orion1]

Buyurun.

Sub vbaileegersay59()
Range("C97").Value = WorksheetFunction.CountIf(Range("C7:C96"), "<0")
Range("C98").Value = WorksheetFunction.CountIf(Range("C7:C96"), "0")
Range("C99").Value = WorksheetFunction.CountIf(Range("C7:C96"), ">0")
End Sub

 

[ultraslan38080]

çok teşekkürler
Bir sorum daha olacak; C7 ile C96 arasındaki sayıların toplamını C100e nasıl yazdırabilirim?

 

[ultraslan38080]

Range("C100").Value = WorksheetFunction.Sum(Range("c7:c96"))

bu kod çalışır mı?

 

[Korhan Ayhan]

Deneyin..

 

[ultraslan38080]

çalıştı

 

[ayhan518]

merhaba, fonksiyonu sırasıyla

Range("AK5").Value = WorksheetFunction.CountIf(Range("F5:AJ5"), "=X")
Range("AK6").Value = WorksheetFunction.CountIf(Range("F6:AJ6"), "=X")
.
.
.
Range("AK505").Value = WorksheetFunction.CountIf(Range("F505:AJ505"), "=X")

yazmak yerine AK5 ile AK505 arasına uygulayabilecek daha uygun bir kod var mıdır?

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub TEST()
    With Range("AK5:AK505")
        .Formula = "=COUNTIF(F5:AJ5,""X"")"
        .Value = .Value
    End With
End Sub

 

[ayhan518]

korhan bey çok teşekkür ediyorum. uyguladım . istediğimde buydu

 

[ayhan518]

bir sorum daha olacak
"mly_sonuc" isimli çalışma sayfamda sırasıyla "A5","C5","D5","F5","G5".........."AJ5" hücrelerindeki (toplam 34 hücre) sadece "X" e eşit olan hücreleri aynı çalışma sayfasında sırasıyla "AL5".........."BS5" hücrelerine(toplam 34 hücre) kopyalayan ve bunu yine 5. satırdan 505. satıra kadar uygulayan bir koda ihtiyacım var. bunu yapmak mümkün müdür?

 

[Korhan Ayhan]

Döngü ile yapabilirsiniz.

 

[ayhan518]

ne yazıkki bu konuda bilgim yok diyebilirim. yardımcı olmanız mümkün müdür acaba

 

[Korhan Ayhan]

İşlem yapılacak hücre adreslerinin tümünü yazar mısınız?

 

[ayhan518]

"mly_sonuc" isimli çalışma sayfamda sırasıyla
"A5","C5","D5","F5","G5", "H5", "I5", "J5", "K5", "L5", "M5", "N5", "O5", "P5", "Q5", "R5", "S5", "T5", "U5", "V5","W5","X5","Y5", "Z5", "AA5", "AB5", "AC5", "AD5", "AE5", "AF5", "AG5", "AH5", "AI5", "AJ5"

hücrelerindeki (toplam 34 hücre) sadece "X" e eşit olan hücreleri aynı çalışma sayfasında sırasıyla
"AL5" "AM5" "AN5" "AO5" "AP5" "AQ5" "AR5" "AS5" "AT5" "AU5" "AV5" "AW5" "AX5" "AY5" "AZ5" "BA5" "BB5" "BC5" "BD5" "BE5" "BF5" "BG5" "BH5" "BI5" "BJ5" "BK5" "BL5" "BM5" "BN5" "BO5" "BP5" "BQ5" "BR5" "BS5"
hücrelerine(toplam 34 hücre) kopyalamak ve bunu yine 5. satırdan 505. satıra kadar uygulamak istiyorum

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub TEST()
    Dim Alan1 As Variant, Alan2 As Variant, X As Integer, Y As Byte
    
    Application.ScreenUpdating = False
    
    Alan1 = Array("A", "C", "D", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "AA", "AB", "AC", "AD", "AE", "AF", "AG", "AH", "AI", "AJ")
    Alan2 = Array("AL", "AM", "AN", "AO", "AP", "AQ", "AR", "AS", "AT", "AU", "AV", "AW", "AX", "AY", "AZ", "BA", "BB", "BC", "BD", "BE", "BF", "BG", "BH", "BI", "BJ", "BK", "BL", "BM", "BN", "BO", "BP", "BQ", "BR", "BS")
    
    For X = 5 To 505
        For Y = 0 To UBound(Alan1)
            If Range(Alan1(Y) & X) = "X" Then
                Range(Alan1(Y) & X).Copy Range(Alan2(Y) & X)
            End If
        Next
    Next
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[ayhan518]

kodu CommandButton ile çalıştırmayı denedim ama sonuç gelmiyor ve excel donuyor maalesef

 

[ayhan518]

günaydın korhan bey sabah kalkar kalkmaz aklıma makro kaydet yöntemi ile yapmak geldi. önce aşağıdaki kod ile istediğim hücreleri kopyalamak istediğim hücrelere kopyaladım

Sub bordroya_kopyala()
    Sheets("mly_operasyon").Activate
    Range("A5:A505,C5:C505,D5:D505,F5:AK505").Select
    Selection.Copy
    Range("AL5").Select
    ActiveSheet.Paste
 
End Sub

daha sonra yalnızca "X" lerin görünmesi için değiştir yöntemiyle hücre değeri "X" dışında olanları boş hücre yaptım.

Sub bordroda_X_olanları_gosterme()
Sheets("mly_operasyon").Activate
    Range("AO5:BS505").Select
    Selection.Replace What:="A", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Selection.Replace What:="D", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
        Selection.Replace What:="H", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
        Selection.Replace What:="İ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
        Selection.Replace What:="K", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
        Selection.Replace What:="O", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
        Selection.Replace What:="T", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
        Selection.Replace What:="İS", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
        Selection.Replace What:="Kİ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
        Selection.Replace What:="KO", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
        Selection.Replace What:="S", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
        Selection.Replace What:="BG", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
End Sub

bu iki makroyu sırasıyla çalıştırınca istediğim oldu kullandığım hücre alanında "X" dışında yalnızca 12 farklı değer olması bu yöntemi uygulamamı sağladı ama işimi görmüş olduğumu düşünüyorum. sizce bu yöntemde bir sorun var mı şu an için.

 

[Korhan Ayhan]

Merhaba,

Ben üstteki mesajımda önerdiğim kod da yazım hatası yapmışım. Gerekli düzeltmeyi yaptım. Son halini tekrar deneyiniz.

Sizin kullandığınız yöntemde kullanılabilir. Önemli olan sonuç almaktır.

 

[ayhan518]

TEŞEKKÜR EDİYORUM İLGİNİZDEN DOLAYI düzelttiğiniz halini de deneyip uygulayacağım

 

[ayhan518]

Merhaba,
EĞER ve EĞERSAY fonksiyonları ile ilgili yine yardımınıza ihtiyacım olacak. Umarım yardımcı olabilirsiniz
çalışma sayfası ismi "mly_ilave_ek"
Userform üzerinden bu çalışma sayfama "F5" ve "AJ5" aralığında 31 gün için her bir hücreye "X" değeri kaydediyorum. o satırdaki "X" değerlerinin toplamını ise "AK5" hücresine yazdırıyorum.
Beceremeyip yardım istediğim husus ise; ben Userform aracılığı ile bu 31 hücreye "X" değeri yazdırmış olsam da en fazla 20 hücrede "X" görünsün istiyorum. satırdaki diğer "X"lerin görünmemesi istiyorum. dolayısıyla toplamları yazdırdığım "AK5" te hücrelerdeki "X" toplamım 20 yi geçmeyecek.
ve bu fonksiyonu ilgili hücreler için 5 ile 505. satırlar arasında uygulamak istiyorum.