Eğer,Birleştir,Eğersay fonksiyonlarının makroda bir arada yazılışı

[peleryn]

Herkese merhabalar ;

=EĞER($K8="K";BİRLEŞTİR("*";EĞERSAY(SEANSLAR!$C$2:$J$224;$C8));EĞERSAY(SEANSLAR!$C$2:$J$224;$C8))

formülünü 8. satıra yazıp 100. satıra kadar aşağı çekerek çoğaltıyorum.aynı işlevi yerine getiren makronun yazılışını öğrenmek istiyorum.

İlgilenen herkese şimdiden teşekkür ederim.

 

[Levent Menteşoğlu]

Formülünüzün A sütununda olduğunu kabul edersek aşağıdaki kodu kullanabilirsiniz.

 Range("A8").AutoFill Destination:=Range("A8:A100"), Type:=xlFillDefault

Not: Kod makro kaydet yöntemi ile elde edilmiş ve düzenlenmiştir.

 

[Orion1]

A sütununa yazar.

Dim i As Byte, deg As Variant
For i = 8 To 100
    If Cells(i, "K").Value = "K" Then
        deg = "*" & WorksheetFunction.CountIf(Sheets("SEANSLAR").Range("C2:J224"), Cells(i, "C").Value)
        Else
        deg = WorksheetFunction.CountIf(Sheets("SEANSLAR").Range("C2:J224"), Cells(i, "C").Value)
    End If
    Cells(i, "A").Value = deg
    deg = ""
Next
MsgBox "İşlem tamamdır.", vbOKOnly + vbInformation, Application.UserName

 

[fedeal]

Bende döngüyle belki tuttururum,
a sütunu oldugunu varsayarsak (değilse sütun sayısını kırmızı olan numaralarla değiştirin)

Sub N()
Set sf1 = Sheets("sayfa1")
Set sf2 = Sheets("SEANSLAR")
For i = 8 To 100
 d = WorksheetFunction.CountIf(sf2.Range("c2:j244"), sf1.Cells(i, 3).Value)
If sf1.Cells(i, "k").Value = "K" Then
sf1.Cells(i, [COLOR="red"]1[/COLOR]).Value = "*" & d
Else
sf1.Cells(i, [COLOR="Red"]1[/COLOR]).Value = d
End If
Next
End Sub

 

[peleryn]

Evren hocam Fedeal hocam kodlarınız tam ihtiyacım olan şekilde pürüzsüz çalışıyor.hızlı cevabınız,ilginiz için çok teşekkür ederim.Böyle kısa sorular ve cevaplarla benim için daha öğretici olduğunu farkettim.Diğer türlü sizlerden aldığım kodları uyarlamakta zorlanıyorum çok zaman.Destekleriniz için çok teşekkürler.

Levent hocam sizin kodunuz da anladığım kadarıyla A8 de bir formül olacak ve o formülü makro ile a8:a100 arasına kopyalayacak.Bu yüzden denemedim.Sanırım sorumu çok açık ifade edemedim ve sizi boşa yormuş oldum.

İlginiz için siz hocalarıma çok teşekkür ederim.

 

[Levent Menteşoğlu]

........Levent hocam sizin kodunuz da anladığım kadarıyla A8 de bir formül olacak ve o formülü makro ile a8:a100 arasına kopyalayacak.Bu yüzden denemedim.Sanırım sorumu çok açık ifade edemedim ve sizi boşa yormuş oldum.

İlginiz için siz hocalarıma çok teşekkür ederim.

Rica ederim. Bende Sn Evren ve Sn fedeal'in cevaplarını görünce soruyu yanlış anladığımı farkettim. Neyse sonuçta sorunuz çözülmüş durumda önemli olanda budur.

 

[tahsinanarat]

Güzel kodlar, ama küçük örnek dosyalar olsada biz meraklılar da anlayabilseydik keşke.

 

[peleryn]

tahsin bey düşündümde haklısınız

dosya ektedir.İyi çalışmalar dilerim.

 

[tahsinanarat]

çok teşekkür ederim Sn. peleryn, güzel sorular ve gelen güzel cevaplar için herkese çok teşekkür ediyorum, herkesin Bayramını şimdiden kutluyorum. Sağolun.