• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

B Sütunundaki her bir tekrarlanan değer için A sütununda indeks oluşturmak

Katılım
29 Haziran 2005
Mesajlar
158
Excel Vers. ve Dili
MS Office Professional Plus 2013 64 Bit -Eng
MSSQL 2012 R2 64 Bit
Merhaba arkadaşlar ;

Yapmak istediğim , B Sütunundaki her bir tekrarlanan değer için A sütununda otomatik indeks oluşturmak...
Bu indeks her farklı değer için 1 den başlayacak ve aynı değerden kaçtane var ise o kadarlık bir indeks olacak..
B sütunundaki veriler ARTAN sıralı olacağından aynı veriler alt alta sıralı olacak...

Fonksiyon veya makro ile yardımcı olabilecek arkadaşlara şimdiden teşekkürler...

Örnek ; resimdeki gibi
 

Ekli dosyalar

  • indeks.jpg
    indeks.jpg
    16.3 KB · Görüntüleme: 12
  • Say_index.xls
    Say_index.xls
    14 KB · Görüntüleme: 4
Son düzenleme:
Bir şey anlamadım.Nerdeki ayni değerden olacak .B ssütunundaki değerlerin hepsi ayni.Sorunuzu daha açık anlatmalısınız.:cool:Hatta bir tane örnek dosya hazırlayımn ki size cevap yazacak kişiler birde dosya hazırlamak durumunda olmasınlar.:cool:
 
Örnek dosya

Örnek dosya
 

Ekli dosyalar

Dosyanız ekte.:cool:
Kod:
Sub indexno()
Dim deg As String, no As Long
deg = Cells(2, "B").Value
Application.ScreenUpdating = False
Range("A2:A65536").ClearContents
For i = 2 To Cells(65536, "B").End(xlUp).Row
    If deg = Cells(i, "B").Value Then
        no = no + 1
        Else
        no = 1
    End If
    Cells(i, "A").Value = no
    deg = Cells(i, "B").Value
Next i
Application.ScreenUpdating = True
MsgBox "İşlem Tamam"
End Sub
 

Ekli dosyalar

Selamlar,

Formülle çözüm isterseniz aşağıdaki formülü A2 hücresine uygulayınız.

Kod:
=EĞER(B2="";"";EĞER(B1=B2;A1+1;1))
 
Dosyanız ekte.:cool:
Kod:
Sub indexno()
Dim deg As String, no As Long
deg = Cells(2, "B").Value
Application.ScreenUpdating = False
Range("A2:A65536").ClearContents
For i = 2 To Cells(65536, "B").End(xlUp).Row
    If deg = Cells(i, "B").Value Then
        no = no + 1
        Else
        no = 1
    End If
    Cells(i, "A").Value = no
    deg = Cells(i, "B").Value
Next i
Application.ScreenUpdating = True
MsgBox "İşlem Tamam"
End Sub

Sayın Evren Gizlen çözümünüz için teşekkür ederim.Başarılı
 
Korhan Ayhan sizin çözümünüz de başarılı ve oldukça pratik , ilginize teşekkürederim.
 
Geri
Üst