Aynı Sutun içerisinde aynı değeri bulma ve çift tek olarak yazma

[alemadam]

Merhabalar iyi günler

ben Aynı Sutun içerisinde aynı değeri bulma ve çift tek olarak yazma makrolama sistemi olarak yapmak istiyorum. nasıl yapcagımı bilmiyorum.. umarım bana yardımcı olacak arkadaşlar vardır....

resim olarak asaagıda görüldüğü gibi

 

[halit3]

B2 hücresine aşağıdaki formülü ekle ve aşağıya doğru sürükleyiniz
500 satırlık kod kendiniz bunu çoğalta bilirsiniz.


=EĞER(EĞERSAY(A$2:A$500;A$2:A$500)=1;"Tek";"")&EĞER(EĞERSAY(A$2:A$500;A$2:A$500)=2;"Çift";"")

=EĞER(EĞERSAY(A$2:A$500;A$2:A$500)=1;"Tek";"")&EĞER(EĞERSAY(A$2:A$500;A$2:A$500)=2;"Çift";"")

 

[alemadam]

evet ama ben makrolama sistemi üzerine istiyorum... çünkü nedeni ise her zaman yeni numaralar ekliyorum...

ama şimdi aynı numaradan 3 tanede var 5 tanede var 10 da var

örnek dosya olarak yolluyayımm ama nasl siteye yüklüyecegim bilmiyorum yardımcı olursan

yükliyeyim...

 

[alemadam]

ekledim örnek dosya bu yardımcı olursan çok sevinirim...

 

[halit3]

3 tane veya beştane olduğu zaman ne yazacak çiftmi yazacak

 

[halit3]

ekli dosyaya bir bakınız.

Sub aktar()
'Worksheets("Sayfa1").Columns("C").ClearContents
son = Worksheets("Sayfa1").Cells(Rows.Count, "A").End(3).Row
Worksheets("Sayfa1").Range("C2" & son).ClearContents
For i = 2 To son
aranan1 = Sheets("Sayfa1").Cells(i, 1).Value
If Sheets("Sayfa1").Cells(i, 1).Value <> "" Then
'MsgBox WorksheetFunction.CountIf(Worksheets("Sayfa1").Range("A2:A" & son), aranan1)
Sheets("Sayfa1").Cells(i, 3).Value = WorksheetFunction.CountIf(Worksheets("Sayfa1").Range("A2:A" & son), aranan1)
Sheets("Sayfa1").Cells(i, 4).Value = WorksheetFunction.CountIf(Worksheets("Sayfa1").Range("A2:A" & i), aranan1)
End If
Next i
MsgBox " İşlem Tamanlanmıştır..."
End Sub

 

[alemadam]

teşekür ederim işime çok yarada saol....

 

[halit3]

teşekür ederim işime çok yarada saol....

iyi çalışmalar

 

[alemadam]

HA BİR SORUNUM VAR!!!!!!

benim telefon rehberim "G" sutununda ne yapmam gerekiyor pekiiiii!!!!!

 

[halit3]

örnek dosyanda A sütununda görüküyor

 

[halit3]

örnek dosyanızda özel bilgiler içermemekle beraber kendi dosyanızla aynı olmasına özen göeteriniz. şimdi kodları yeniden revize etmek gerekiyor.

Sub aktar()
son = Worksheets("Sayfa1").Cells(Rows.Count, "G").End(3).Row
Worksheets("Sayfa1").Range("h2" & son).ClearContents
For i = 2 To son
aranan1 = Sheets("Sayfa1").Cells(i, "G").Value
If Sheets("Sayfa1").Cells(i, "G").Value <> "" Then
Sheets("Sayfa1").Cells(i, "h").Value = WorksheetFunction.CountIf(Worksheets("Sayfa1"). Range("G2:G" & son), aranan1)
End If
Next i
MsgBox " İşlem Tamanlanmıştır..."
End Sub

 

[alemadam]

özür dilerim birde sizden sadece o " taplam adet " istemekteyim. " toplam sıra adeti " gerek yoktur halit bey...

örnek dosya aşşagıdadır.

 

[halit3]

11 nolu mesajı güncelledim.