Yan yana olan tekrarları sayma

[direful]

Arkadaşlar merhaba,

Şöyle bir tablom mevcut.




Bu tabloda yan yana bulunan 3'lü ''x'' lerin ve 4'lü ''x'''lerin otomatik olarak kaç tane olduğunu N ve M sütunundaki gibi yazmasını istiyorum.


Yardımlarım ederseniz sevinirim.

Saygılarımla.

 

[muygun]

Merhaba;
A sütununa boş bir sütun ekleyin. (verileriniz B sütunundan başlasın)
Sonra sayfanın kod bölümüne;

Sub sayy()
Application.ScreenUpdating = False
On Error Resume Next
Range("o265536").Select
Selection.ClearContents
Range("n2").Select
Set s1 = ThisWorkbook.Worksheets("Sayfa1")
For i = 2 To 100
For k = 2 To 13
If s1.Cells(i, k - 1) = "" And s1.Cells(i, k) = "x" And s1.Cells(i, k + 1) = "x" And s1.Cells(i, k + 2) = "x" And s1.Cells(i, k + 3) = "" Then s1.Cells(i, "o") = s1.Cells(i, "o") + 1
If s1.Cells(i, k - 1) = "" And s1.Cells(i, k) = "x" And s1.Cells(i, k + 1) = "x" And s1.Cells(i, k + 2) = "x" And s1.Cells(i, k + 3) = "x" And s1.Cells(i, k + 4) = "" Then s1.Cells(i, "p") = s1.Cells(i, "p") + 1
Next k
Next i
Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub

Kodlarını yerleştirin ve bunu bir butona bağlayın.
Sonra butona basın.
İyi çalışmalar.

Not:Örneğinizle 3 lünün son satırı neden 2?

 

[direful]

Merhaba;
A sütununa boş bir sütun ekleyin. (verileriniz B sütunundan başlasın)
Sonra sayfanın kod bölümüne;

Sub sayy()
Application.ScreenUpdating = False
On Error Resume Next
Range("o265536").Select
Selection.ClearContents
Range("n2").Select
Set s1 = ThisWorkbook.Worksheets("Sayfa1")
For i = 2 To 100
For k = 2 To 13
If s1.Cells(i, k - 1) = "" And s1.Cells(i, k) = "x" And s1.Cells(i, k + 1) = "x" And s1.Cells(i, k + 2) = "x" And s1.Cells(i, k + 3) = "" Then s1.Cells(i, "o") = s1.Cells(i, "o") + 1
If s1.Cells(i, k - 1) = "" And s1.Cells(i, k) = "x" And s1.Cells(i, k + 1) = "x" And s1.Cells(i, k + 2) = "x" And s1.Cells(i, k + 3) = "x" And s1.Cells(i, k + 4) = "" Then s1.Cells(i, "p") = s1.Cells(i, "p") + 1
Next k
Next i
Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub

Kodlarını yerleştirin ve bunu bir butona bağlayın.
Sonra butona basın.
İyi çalışmalar.

Not:Örneğinizle 3 lünün son satırı neden 2?

Hocam öncelikle cevabınız için teşekkür ederim. Buton atama işlemini VB 2010'a göre buluyorum. Ücretli üyelikten dolayı da dosyanızı açamıyorum. Yani buton ekleyemiyorum bir türlü.

3'lünün son satırı da benim hatam yüzünden 2 olarak gözüküyor. 1 adet ''x'' silinmiş. Yani 1 olması gerekiyordu.

Yardımcı olabilirseniz sevinirim.