hangi koşulun kaçıncısı..?

[peleryn]

Herkese Merhabalar;

Ek'li dosyamda engelli çocuklarımıza vermekte olduğumuz bireysel ve grup seanslarımızı tarih,saat ve verilen hizmet türünü baz alarak verilen seans sayısı kadar formül ya da makro ile nasıl numaralandırabileceğimizle ilgili bir soru var.Sorunun yapısı gereği şu an ki ifadelerimle ihtiyacımı tam ifade edemediğimin farkındayım.

Sorunun daha ayrıntılı tanımı dosyada vardır.

İlgilenecek olanlara şimdiden teşekkür ederim.:hey:

 

[excel03]

merhaba;

Sub sırala()
Dim alan As Range
sonsat = Cells(65536, 1).End(3).Row
Set alan = Range("a2:a" & sonsat)
x = 0
alan.Offset(0, 1).Font.Bold = False
alan.Offset(0, 1).Font.Color = vbBlack
alan.Offset(0, 1).ClearContents

For i = 1 To alan.Cells.Count
y = alan.Cells(i).Value

If x = y Then
        If alan.Cells(i).Offset(0, 5).Value = "BİREYSEL" Then
        HB = HB + 1
        alan.Cells(i).Offset(0, 1).Value = HB
        End If
        If alan.Cells(i).Offset(0, 5).Value = "GRUP" Then
        HG = HG + 1
        alan.Cells(i).Offset(0, 1).Value = HG
        alan.Cells(i).Offset(0, 1).Font.Color = vbRed
        alan.Cells(i).Offset(0, 1).Font.Bold = True
        End If
Else
        HB = 0
        HG = 0
        x = y
        If alan.Cells(i).Offset(0, 5).Value = "BİREYSEL" Then
        HB = HB + 1
        alan.Cells(i).Offset(0, 1).Value = HB
        End If
        If alan.Cells(i).Offset(0, 5).Value = "GRUP" Then
        HG = HG + 1
        alan.Cells(i).Offset(0, 1).Value = HG
        alan.Cells(i).Offset(0, 1).Font.Color = vbRed
        alan.Cells(i).Offset(0, 1).Font.Bold = True
        End If
End If

Next

End Sub

 

[peleryn]

Sayın excel03;

Güzel çözümünüz ve hızlı yardımınız için çok teşekkür ederim.Tek kelimeyle harika çalışıyor elinize sağlık..

 

[Korhan Ayhan]

Selamlar,

Alternatif olarak işlemi formülle yapmak isterseniz B2 hücresine uygulayıp alt hücrelere sürükleyiniz.

=TOPLA.ÇARPIM((A$2:A2=A2)*(F$2:F2=F2))

 

[peleryn]

Selamlar,

Alternatif olarak işlemi formülle yapmak isterseniz B2 hücresine uygulayıp alt hücrelere sürükleyiniz.

=TOPLA.ÇARPIM((A$2:A2=A2)*(F$2:F2=F2))

Korhan Hocam resmen büyülendim..Ustalığın konuştuğu nokta bu sadelik işte..Aklınıza,bilginize sağlık..Teşekkürler hocam..