Hücreleri birleştirip saydırma

[mahmutozdemir]

Slm,
D+E+F ( f boşsa yazmasın) hücrelerini birleştirip sayısını G hücresine yazsın şeklinde bir makro oluşturabilirmiyiz.
Yani =D2&E2&F2 ,=Eğersay(H2:h6568,H2) formüllerinin makroya cevrilmiş hali olarak düşünebiliriz.

 

[Ergün Güler]

Slm,
D+E+F ( f boşsa yazmasın) hücrelerini birleştirip sayısını G hücresine yazsın şeklinde bir makro oluşturabilirmiyiz.
Yani =D2&E2&F2 ,=Eğersay(H2:h6568,H2) formüllerinin makroya cevrilmiş hali olarak düşünebiliriz.

Selam,

aşağıdaki sizin açtığınız konuya bir çalışma ekledim. Böyle birşey mi istiyorsunuz?

http://www.excel.web.tr/f14/tum-verileri-ayny-olunca-rengi-deoi-sin-t96431/sayfa2.html

 

[Ergün Güler]

Slm,
D+E+F ( f boşsa yazmasın) hücrelerini birleştirip sayısını G hücresine yazsın şeklinde bir makro oluşturabilirmiyiz.
Yani =D2&E2&F2 ,=Eğersay(H2:h6568,H2) formüllerinin makroya cevrilmiş hali olarak düşünebiliriz.

Selam,
bir modüle

Sub mükerrer_say()
Dim s1 As Worksheet
Dim WF As WorksheetFunction

Set s1 = Sheets("Sayfa1")

Set WF = WorksheetFunction

s1_son = s1.Range("A65536").End(3).Row

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

s1.Columns("G:G").ClearContents
s1.Columns("IV:IV").ClearContents

For i = 2 To s1_son

If s1.Cells(i, "D") = "" Or s1.Cells(i, "E") = "" Or s1.Cells(i, "F") = "" Then
s1.Cells(i, "IV") = ""

Else
s1.Cells(i, "IV") = s1.Cells(i, "D") & s1.Cells(i, "E") & s1.Cells(i, "F")
End If
Next

For j = 2 To s1_son
If s1.Cells(j, "IV") <> "" Then
s1.Cells(j, "G") = WF.CountIf(s1.Range("IV2:IV" & s1_son), s1.Cells(j, "IV"))
End If
Next

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Sayma İşlemi Tamamlanmıştır", vbInformation
End Sub

 

[mahmutozdemir]

Ergün bey teşekkürler.Tam istediğimi gibi,
F boş hücreyse saymıyor çok güzel 0 yada zihinsel yazan hücreleri saymasa olabilirmi.

 

[Ergün Güler]

Ergün bey teşekkürler.Tam istediğimi gibi,
F boş hücreyse saymıyor çok güzel 0 yada zihinsel yazan hücreleri saymasa olabilirmi.

Selam,

Kodlardaki kırmızı alanları istediğiniz gibi kendiniz de düzenleyebilirsiniz.

[COLOR="Red"]If s1.Cells(i, "D") = "" Or s1.Cells(i, "E") = "" Or s1.Cells(i, "F") = "" Then[/COLOR]
s1.Cells(i, "IV") = ""
Else
s1.Cells(i, "IV") = s1.Cells(i, "D") & s1.Cells(i, "E") & s1.Cells(i, "F")
End If
Next

 

[mahmutozdemir]

Ergün Bey,
s1.Cells(i, "IV") de IV ne için birde Kırmızı yazan yeri nasıl hem boşu hemde 0 saymasın yapabiliriz.

 

[Ergün Güler]

Ergün Bey,
s1.Cells(i, "IV") de IV ne için birde Kırmızı yazan yeri nasıl hem boşu hemde 0 saymasın yapabiliriz.

s1.Cells(i, "IV") de IV ne için

IV excel sayfasının 256. yani en son sütunudur. Kullanmayacağınızı düşünerek yardımcı verileri buraya yazılıp siliniyor.
en son mesajınızda

F boş hücreyse saymıyor çok güzel 0 yada zihinsel yazan hücreleri saymasa olabilirmi.

1.mesajınızdaki dosyanızı inceledim. F sütununda ne "0" var ne de "zihinsel" hangi sütunda hangi sartı istiyorsanız tam yazınız.

 

[mahmutozdemir]

dosyayı ekledim.

 

[Ergün Güler]

dosyayı ekledim.

Mahmut Bey,

Sub mükerrer_say()

Dim s1 As Worksheet
Dim WF As WorksheetFunction

Set s1 = Sheets("Sayfa1")

Set WF = WorksheetFunction

s1_son = s1.Range("A65536").End(3).Row

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

s1.Range("G:I").ClearContents
s1.Range("IT:IV").ClearContents

For i = 2 To s1_son
    If s1.Cells(i, "F") <> "" And s1.Cells(i, "F") <> 0 Then
    s1.Cells(i, "IV") = s1.Cells(i, "D") & s1.Cells(i, "E") & s1.Cells(i, "F")
    End If
    
    If s1.Cells(i, "C") <> "" And s1.Cells(i, "C") <> 0 And s1.Cells(i, "C").Value <> "ZİHİNSEL" Then
    s1.Cells(i, "IU") = s1.Cells(i, "C") & s1.Cells(i, "D") & s1.Cells(i, "E")
    End If
    
    If s1.Cells(i, "F") <> "" And s1.Cells(i, "F") <> 0 Then
    s1.Cells(i, "IT") = s1.Cells(i, "D") & s1.Cells(i, "F")
    End If
Next

For J = 2 To s1_son
    If s1.Cells(J, "IV") <> "" Then
    s1.Cells(J, "G") = WF.CountIf(s1.Range("IV2:IV" & s1_son), s1.Cells(J, "IV"))
    End If
    
    If s1.Cells(J, "IU") <> "" Then
    s1.Cells(J, "H") = WF.CountIf(s1.Range("IU2:IU" & s1_son), s1.Cells(J, "IU"))
    End If
    
    If s1.Cells(J, "IT") <> "" Then
    s1.Cells(J, "I") = WF.CountIf(s1.Range("IT2:IT" & s1_son), s1.Cells(J, "IT"))
    End If
Next

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Sayma İşlemi Tamamlanmıştır", vbInformation
End Sub

örnek dosyanızda

h sutununa c+d+e
birleştirip saysın
(e deki boş , 0 ve zihinsel olan hücreleri saymasın)

diyorsunuz ancak E'de böye birşey yok bu yüzden C sütununu referans aldım.

 

[mahmutozdemir]

Çok teşekkür ederim

 

[Ergün Güler]

Çok teşekkür ederim

Selam,
Ben teşekkür ederim.
İyi çalışmalar.

 

[mahmutozdemir]

Merhabalar Ergün Bey,
Birleştirme yaparken çoğunda yanlış birleştirme yapmış bir kontrol edebilirmisiniz.
Ben bir kaçını işaretledim.

 

[Ergün Güler]

Merhabalar Ergün Bey,
Birleştirme yaparken çoğunda yanlış birleştirme yapmış bir kontrol edebilirmisiniz.
Ben bir kaçını işaretledim.

Selam,
Siz Süzme işlemi yaptıktan sonra kodları çalıştırmışınız. Bu yüzden hatalı olmuş olabilir veya farklı bir başkakod çalıştırmış ve bu sayfada geçerli olmuş olabilir.
Ben bir kaç kez denedim. Yanlış gösterdiklerininiz hepsi düzeldi.
İyi çalışmalar.