kelime analizi için !

[erencexor]

aslında sayısal tablolar ile uzaktan yakında bir alakam yoktu
ama bu gün gerçekten ne kadar önemli bir şey olduğunu fark ettim !

soru şu :
elimizde bir txt dökümanı var
şimdi bu dökündaki bilgileri
A sütünuna yukarıdan aşağı veri girdik
ama burada istenilen şu !

A
a
b
b
c
d
d
d

şeklinde yüzlerce kelime var !
şimdi asıl istenilen şu
aynı kelimeleri birleştirip sağtaraflarında bundan kaçtane olduğunu yazıkması isteniyor

örneğin :
"d" den "3" tane
"b" den "2" tane
"A" den "1" tane
"a" den "1" tane
"c" den "1" tane

gibi yani en çok kullanılan tanımlamaların
istatiksel bir sonucunu tablosunu elde etmek isteniyor
bunu adım adım nasıl yapabiliriz !?

her şey için sonsuz teşekürlerimle

 

[Necdet]

Sizin örnekte A ve a ayrı gibi, dolayısıyla verdiğim örnekte A ve a aynı sayılmaktadır. Sözcük olarak tabi ki farklılıklar olacaktır.

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı incelermisiniz.

Kullanılan kodun açıklamaları;

Sub İSTATİSTİK()
    [D2:E65536].ClearContents
    SATIR = 2
    SON_SATIR = [A65536].End(3).Address
    For X = 2 To [A65536].End(3).Row
    SAY = Evaluate("=SUMPRODUCT(--(EXACT($A$2:" & Cells(X, 1).Address & "," & Cells(X, 1).Address & ")))")
    If SAY = 1 Then
    Cells(SATIR, 4) = Cells(X, 1)
    Cells(SATIR, 5) = "=SUMPRODUCT(--(EXACT($A$2:" & SON_SATIR & "," & Cells(SATIR, 4).Address(0, 0) & ")))"
    SATIR = SATIR + 1
    End If
    Next
    Columns("D:E").Sort Key1:=Range("E2"), Order1:=xlDescending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

'KULLANILAN KODUN AÇIKLAMALARI
'1. SATIR - MAKROMUZA İSTATİSTİK ADINI VERİYORUZ.
'2. SATIR - D2:E65536 HÜCRE ARALIĞINI TEMİZLİYORUZ.
'3. SATIR - SATIR DEĞİŞKENİNE 2 DEĞERİNİ VERİYORUZ.
'4. SATIR - SON_SATIR DEĞİŞKENİNE A SÜTUNUNDAKİ EN SON DOLU HÜCRENİN ADRESİNİ TANIMLIYORUZ.
'5. SATIR - X İSİMLİ BİR DÖNGÜ BAŞLATIYORUZ.
'6. SATIR - SAY İSİMLİ DEĞİŞKENE A SÜTUNUNDAKİ X DEĞERİNİN ALDIĞI HÜCREDEKİ DEĞERİ SAYDIRIP DEĞİŞKENE TANIMLIYORUZ.
'7. SATIR - EĞER SAY=1 İSE ŞARTINI SORGULUYORUZ.
'8. SATIR - D SÜTUNUNDAKİ İLK BOŞ HÜCREYE SAYDIRDIĞIMIZ BU DEĞERİ AKTARIYORUZ.
'9. SATIR - E SÜTUNUNDAKİ İLK BOŞ HÜCREYE SAYMA FORMÜLÜNÜ AKTARIYORUZ.
'10. SATIR - ŞARTIMIZ SAĞLANIYORSA SATIR İSİMLİ DEĞİŞKENİN DEĞERİNE 1 EKLİYORUZ.
'11. SATIR - ŞARTIMIZI SONLANDIRIYORUZ.
'12. SATIR - DÖNGÜMÜZE DEVAM EDİYORUZ.
'13-14. SATIR - OLUŞAN LİSTEMİZİ BÜYÜKTEN KÜÇÜĞE SIRALATIYORUZ.
'15. SATIR - İŞLEMİN BİTTİĞİNE DAİR KULLANICIYA BİLGİ MESAJI VERİYORUZ.
'16. SATIR - MAKROMUZU SONLANDIRIYORUZ.

 

[erencexor]

örnek.rar tam istediğim gibi
emeğinize teşekür ederim.
son bir şey daha istiyorum
örneğin sizin yazdığınız cod

LİSTE ADET
A 1
a 3
b 2
c 2
C 1
d 4

böyle yapıyor ama
asıl önemli olan şu !

aşağıdaki şu şekilde :

LİSTE ADET
d 4
a 3
b 2
c 2
A 1
C 1

olduğu gibi en fazla geçen tanımlamaların sayısına göre sıralanmış olursa
gerçekten çok sevinirim

tekrardan verdiğiniz emek için sonsuz teşekürler

çalışmalarınızda başarılar dilerim

 

[Korhan Ayhan]

Selamlar,

Üstteki mesajımdaki dosyayı güncelledim incelermisiniz.

 

[erencexor]

sanıyorum yeni kod da bir hata var

fakat bu en son yolladınız "örnek.rar" dosyasını çalıştırdığımda !

önceki düzgün çalışıyordu !
ve bu gönderdiğiniz dokumanda şu an da önceki gibi çalışıyor

ve ama adet sayısına göre sıralama yapıyor !

sonra ekrana bir hata mesajı geliyor

" Run-time error '10042: "
" Application- defined or object-defined error "

 

[Korhan Ayhan]

Selamlar,

Kod hangi satırda hata veriyor belirtirmisiniz.

 

[erencexor]

debug tuşuna basınca !
sarı ok'un üzerini sarı olarak çizdiği 2 satırın codu :

 Columns("D:E").Sort Key1:=Range("E2"), Order1:=xlDescending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

 

[Mdemir63]

Merhabalar,

Hocam şu satır satır açıklamalarınız için çok teşekkür ederim.
Çok zahmet vermişsiniz ama çok daha öğretici olduğunu söylemek istedim. Ellerinize sağlık.

Saygılarımı sunarım

 

[Korhan Ayhan]

Selamlar,

Hata veren kısmı aşağıdaki şekilde değiştirip denermisiniz.

    [D1:E65536].Sort Key1:=Range("E2"), Order1:=xlDescending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

 

[erencexor]

özür dilerim ama sizi tekrar yoracağım !
bu kodtaki hatayı yeri düzeleyip tekrar yollarmısınız !?
çünkü nereden ne yapılacağını gerçekten bilmiyorum
az önce denedim gene garip garip hatalar verdi !

( bu arada mümkünse yeni gönderceğiniz dosyanın adı "istatistik.xls" olsun

bu konunun ileride bir çok kişinin işine yarayacağını düşünüyorum
onun için tekrar sizi yorduğum için özür dilerim !

çalışmalarınızda başarılar dilerim
saygılarımla

 

[Korhan Ayhan]

Selamlar,

Ekteki dosya güncellenmiştir. İncelermisiniz.

 

[erencexor]

tekrar özür diliyerekten !

yani bir sorun oluştu !

İSTATİSTİK.rar dosyasını indirdim
rarı açtım içindeki "İSTATİSTİK.xls" dosyasını direk çalıştırdım !

[ istatistik ] butonuna basmadan sanki [ istatistik ] butonuna basılmış gibi veriler sıralanmıştı

LİSTE			LİSTE	ADET
A			d	4
a			a	3
a			b	2
a			c	2
b			A	1
b			C	1
c				
C				
c				
d				
d				
d				
d

fakat şimdi
bu değerlere ek
yeni veriler gidiğimde ise !

örneğin : 3 satır e harfi girdim ve istatistik tuşuma bastığımda
gene hata ekranı geldi

debug dediğimde ise !

[D1:E65536].Sort Key1:=Range("E2"), Order1:=xlDescending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

valla sizide baya bir yorduk ama işte bilsem kendim yapacağım
ama bilmiyorum !

 

[Korhan Ayhan]

Selamlar,

Tüm denemelerimde kod gayet güzel çalışıyor. Acaba sizin kullandığınız versiyonla alakalı bir sorun olabilirmi?

 

[erencexor]

yaw TR - 2K ama benim merak ettiğim niye böyle sorunlar yaşanıyor !
mesela

bende düzgün çalışan xls dosyasını ekle yoluyorum

burada istenilen en çok değerden aşağıya doğru
şu şekilde :

örneğin :
"d" den "5" tane
"b" den "4" tane
"A" den "3" tane
"a" den "2" tane
"c" den "1" tane

sonuç vermesini istiyorum başka hiç bir sorum yok !

 

[kombo]

Sayın erencexor

Kodlar gayet güzel çalışıyor. Ama formül hücrede kaldığı için devamlı işlem yapıyor. Sayın COST_CONTROL 'un kodlarına aşağıdaki kırmızı satırları ilave edin.

 [COLOR=darkgreen][D1:E65536].Sort Key1:=Range("E2"), Order1:=xlDescending, Header:=xlGuess, _[/COLOR]
[COLOR=darkgreen]   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal[/COLOR]
   [COLOR=red][D2:E500].Copy[/COLOR]
[COLOR=red]   [D2].PasteSpecial Paste:=xlPasteValues[/COLOR]
[COLOR=red]   [d1].Select[/COLOR]
[COLOR=red]   Application.CutCopyMode = False[/COLOR]
    [COLOR=darkgreen]MsgBox "İşleminiz tamamlanmıştır.", vbInformation[/COLOR]

 

[erencexor]

gerçekten bırak kodu yazmasını eklemesini bile bilmiyorum !
az önce ekleyim dedim benim elim değince daha fazla hata veriyor bu şey !

! kafam iyice karıştı
lütfen en son eklediğiniz kodla yeniden
xls dosyası olarak tekrardan gönderirmisiniz
!

 

[veyselemre]

Aşağıdaki kodları da deneyebilirsiniz.

Sub ozetle()
son = [a65536].End(3).Row
ReDim dizi(2 To son, 1 To 2)
For x = LBound(dizi) To UBound(dizi)
    dizi(x, 1) = Cells(x, 1)
    dizi(x, 2) = 1
Next x
For x = LBound(dizi) To UBound(dizi) - 1
    For y = x + 1 To UBound(dizi)
        If dizi(x, 1) <> "" And dizi(x, 1) = dizi(y, 1) Then
            dizi(x, 2) = dizi(x, 2) + dizi(y, 2)
            dizi(y, 1) = ""
        End If
    Next y
Next x
[d2:e65536].ClearContents
sat = 1
For x = LBound(dizi) To UBound(dizi)
    If dizi(x, 1) <> "" Then
        sat = sat + 1
        Cells(sat, "D") = dizi(x, 1)
        Cells(sat, "E") = dizi(x, 2)
    End If
Next x
[d:E].Sort Key1:=Range("E2"), Order1:=xlDescending, Header:=xlGuess
Erase dizi
End Sub

 

[erencexor]

ben kodlarında bir şey anlamıyorum
anlasaydım kendim yazardım büyük bir ihtimal !
lütfen xls dosyası olarak gönderiniz !

 

[erencexor]

Aşağıdaki kodları da deneyebilirsiniz.

Sub ozetle()
son = [a65536].End(3).Row
ReDim dizi(2 To son, 1 To 2)
For x = LBound(dizi) To UBound(dizi)
    dizi(x, 1) = Cells(x, 1)
    dizi(x, 2) = 1
Next x
For x = LBound(dizi) To UBound(dizi) - 1
    For y = x + 1 To UBound(dizi)
        If dizi(x, 1) <> "" And dizi(x, 1) = dizi(y, 1) Then
            dizi(x, 2) = dizi(x, 2) + dizi(y, 2)
            dizi(y, 1) = ""
        End If
    Next y
Next x
[d2:e65536].ClearContents
sat = 1
For x = LBound(dizi) To UBound(dizi)
    If dizi(x, 1) <> "" Then
        sat = sat + 1
        Cells(sat, "D") = dizi(x, 1)
        Cells(sat, "E") = dizi(x, 2)
    End If
Next x
[d:E].Sort Key1:=Range("E2"), Order1:=xlDescending, Header:=xlGuess
Erase dizi
End Sub

şu kodu derleyebilirmisiniz ?