sayma işlemi yaptırma

[XExcel]

Selamlar,

Örnek dosyada elimden geldiğince açıklamaya çalıştım. Yardımcı olanlara teşekür ederim. Allah razı olsun.

 

[halit3]

Selamlar,

Örnek dosyada elimden geldiğince açıklamaya çalıştım. Yardımcı olanlara teşekür ederim. Allah razı olsun.

Kodu bir deneyin

Option Explicit
Sub arama()
Dim x, s, r, i, say
Application.ScreenUpdating = False
say = Cells(7, "k").Value
For r = 1 To Cells(8, "k").Value Step say 
i = 0
Set s = CreateObject("Scripting.Dictionary")
For Each x In Range(Cells(r, "a"), Cells(r + say - 1, "j"))
If x.Value <> "" Then
If IsNumeric(x.Value) = True Then
If x.Interior.ColorIndex = 3 = True Then
If Not s.exists(x.Value) Then
s.Add x.Value, Nothing
i = i + 1
End If
End If
End If
End If
Next x
If i > 0 Then
Cells(r + say - 1, "m").Value = i
End If
Next r
Application.ScreenUpdating = True
MsgBox "işlem tamam"
End Sub

buda başka kod

Option Explicit
Sub arama()
Dim x, s, r, say, say2, deg1, deg2, son
Application.ScreenUpdating = False
deg1 = Cells(7, "k").Value
deg2 = Cells(8, "k").Value
If Val(deg1) = 0 Then MsgBox "sayma aralığı K7 hücresinde sayı yok": Exit Sub
If Val(deg2) < Val(deg1) Then MsgBox "bitiş satırı K8 hücresi sayma aralığından büyük olması gerekir": Exit Sub
For r = 1 To deg2 Step deg1
say = 0
say2 = ""
If (r + deg1 - 1) < deg2 Then
son = (r + deg1 - 1)
Else
son = deg2
End If
Set s = CreateObject("Scripting.Dictionary")
For Each x In Range(Cells(r, "a"), Cells(son, "j"))
If x.Value <> "" Then
If IsNumeric(x.Value) = True Then
If x.Interior.ColorIndex = 3 = True Then
If Not s.exists(x.Value) Then
s.Add x.Value, Nothing
say = say + 1
If say = 1 Then
say2 = x.Value
Else
say2 = say2 & "_" & x.Value
End If
End If
End If
End If
End If
Next x
If say > 0 Then
Cells(son, "m").Value = say
Cells(son, "n").Value = say2
End If
Next r
Application.ScreenUpdating = True
MsgBox "işlem tamam"
End Sub

 

[halit3]

Selamlar,

Örnek dosyada elimden geldiğince açıklamaya çalıştım. Yardımcı olanlara teşekür ederim. Allah razı olsun.

Acaba kod işinizi görmedimi.?
Geri dönüş yapılmadığından soruyorum.

 

[halit3]

Selamlar,

Örnek dosyada elimden geldiğince açıklamaya çalıştım. Yardımcı olanlara teşekür ederim. Allah razı olsun.

Sisteme girdiğiniz halde niçin geri dönüş yapmıyorsunuz? yazılan kodlar işinizi görmedimi o kadar emek verip zamanımızı harcıyoruz bu kodları yazmak için bir teşekkür bili etmeyi bize çok mu görüyorsunuz.

 

[mbldn]

Sisteme girdiğiniz halde niçin geri dönüş yapmıyorsunuz? yazılan kodlar işinizi görmedimi o kadar emek verip zamanımızı harcıyoruz bu kodları yazmak için bir teşekkür bili etmeyi bize çok mu görüyorsunuz.

Halit Hocam eline koluna beynine sağlık;
onun işine yaradı mı bilmem ancak benim başka bir sorumu çözdü
teşekkürler.

 

[halit3]

Halit Hocam eline koluna beynine sağlık;
onun işine yaradı mı bilmem ancak benim başka bir sorumu çözdü
teşekkürler.

Soruyu soran üyemiz cevabını aldıktan sonra bir daha görünmüyor onca emek veriyoruz çözümün işe yarayıp yaramadığını bilmiyoruz.

Duyarlı olduğunuz için Sizede ben teşekkür ederim.
iyi çalışmalar