sırala

[k.guclu]

Merhaba arkadaşlar aşağıda gönderdiğim sayı düzeniyle yazılan sayıları küçükten büyüğe nasıl sıralayabilirim.
Aşağıdada görüldüğü gibi 100-100 sonra 1001-001 geliyor halbuki 100-200 gelmesi gerek.
Bir türlü beceremedim. Yardımcı olursanız memnun olurum.
SAYGILARIMLA EXCEL WEB DOSTALARINA

097-703
097-704
098-100
098-200
099-000
100-100
1001-001
1001-002
1001-003
1001-101
1001-102
1001-201
1001-202
1001-301
1001-302
1001-400
100-200
1002-101
1002-102
1002-103

 

[k.guclu]

üstatlar bir yorumunuz yok mu?
Saygılarımla

 

[dEdE]

Merhaba,
Aşağıdaki kodlar işinizi görür.
Ancak geçici olarak B sütununu kullanmaktadır. B sütununda veriniz varsa araya bir sütun ekleyiniz.

Hoşça kalın.

Sub Sırala()
    Columns("A:A").Select
    Selection.TextToColumns Range("A1"), Other:=True, OtherChar:="-", FieldInfo:=Array(Array(1, 1), Array(2, 1))
    Range("A1:B20").Sort Key1:=Range("A1"), Order1:=xlAscending
    Range("A1").Select
For i = 1 To [A65536].End(3).Row
    Cells(i, 1).Value = Cells(i, 1).Value & "-" & Cells(i, 2).Value
Next
    Range("B:B").ClearContents
    MsgBox "İşlem Tamam.", , "dEdE İyi Günler Diler."
End Sub

 

[Orion1]

Alternatif:
Yedek sütun kullanmadan.
Verilerin A sütununda olduğu kabul edilmiştir.

Sub sirala()
Dim i As Long, deg1 As Long, deg2 As Long
Dim j As Long, x As Variant
On Error Resume Next
Application.ScreenUpdating = False
For i = 1 To Cells(65536, "A").End(xlUp).Row - 1
    deg1 = Replace(Cells(i, "A").Value, "-", "")
    For j = i + 1 To Cells(65536, "A").End(xlUp).Row
        deg2 = Replace(Cells(j, "A").Value, "-", "")
        If deg1 > deg2 Then
            x = Cells(i, "A").Value
            Cells(i, "A").Value = Cells(j, "A").Value
            Cells(j, "A").Value = x
        End If
    Next j
Next i
Application.ScreenUpdating = True
MsgBox "Sıralama tamamlandı"
End Sub

 

[k.guclu]

Makro Sonuçları

Arkadaşlar çok teşekkür ederim. Elinize emeğinize sağlık, değerli vaktinizi buna ayırdınız.

Dün akşam internete giremediğim için tekrar dönemedim.

Gönderdiğiniz makroları denedim. Sonuçları aşağıda belirttiğim gibi oldu.

CEVAP-1 SAYIN dEdE DİKKATİNE)

dEdE üstadım dediğiniz gibi ayarlayıp denediğimde aşağıdaki gibi bir sıralama yapıyor halbuki 89-110 'dan sonra 89-111 gelmesi gerek. Fakat 89-1101 geliyor.

89-105
89-109
89-110
89-1101
89-1102
89-1103
89-1104
89-1105
89-1106
89-1107
89-1108
89-1109
89-111
89-1110
89-1111
89-1112
89-1113
89-112
89-113


CEVAP-2 SAYIN Evren Gizlen DİKKATİNE)

Üstat sizin verdiğiniz makroyu denedim. hata verdi.

Hata Kodu: "Code execution has been interrupted"

Sarıladığı alan If deg1 > deg2 Then

Toplamda bu şekil 14327 sayı girdim. Bilginize sunarım.


SONUÇ: Yapmak istediğim iki sayım var "abcd" ve "efgh"bunlar "-" ile birbirinde ayrılıyor.

Örnek (89-101, 1001-1000, 985-105 vb.)

Sıralama yaparken ilk önce soldaki sayıyı dikkate alacak ondan sonra sağdaki sayıya göre sıralıyacak.

Tekrardan çok teşekkür ederim. Bunca emeği ve zamanı ayırdığınız için.

 

[Orion1]

Ben kodları deneyipte yolladım bir hata vermedi.
Siz listenizi boş bir Excel dosyasına A sütununa kopyalayıp yollayın bakalım neden oluyormuş.Aslında olmamamsı lazım hatanın.

 

[k.guclu]

Belki ben hatalı birşey yaptım.

Üstat ilişikte gönderdim.

Bilginize sunarım.

 

[Orion1]

O hata çalışmanın kesilmesi ile oluşuyor.Ben ctrl+break tuşlarına basıp çalışmayı kestiğim zaman ayni hatayı aldım.
168nci satıra kadar sıralama yaptı ancak 5 dakika sürdü.
2,66 mhz tek çekirdekli işlemci 512 mb ram ile.
Çok yüksek konfigürasyonlu PC lazım bu işlem için.4 çekirdekli 3-4 mb ram gibi.
Yoksa bunun ile yarım saat 1 saat beklenir.Pek kullanışlı olmayacak gibi görünüyor.Normalde hata vermedi.Ama taamamını çalıştırmadım.168nci satıra kadar çalıştırdım.Veri çok çünkü.
Kolay gelsin.

 

[k.guclu]

Tamm üstat çok teşekkür ederim. Zaman harcadın. bende iyi bir bilgisayarda bir kere deneyeyim.

 

[Orion1]

Kodlarda bir hata varmış onu düzelttim.
A sütunundaki verileri dizi içine aldım ve öyle yaparak süreyi 10 dakikaya indirdim.
Ancak sizin yolladığınız karakterlerin içinde - tre karakterinin dışındada karakterler var bu yüzden onları sıralayamayıp boş bıraktı.Çünkü siz sadece tre işareti olanları demiştiniz.Onlara göre yaptımŞimdi 10 dakiada sıralam yapıyor.Tre işatreti dışındaki hücreleri boş bırakıyor.Dosya ekte

Sub sirala()
Dim i As Long, deg1 As Long, deg2 As Long
Dim j As Long, x As Variant, liste()
liste = Range("A1:A" & Cells(65536, "A").End(xlUp).Row).Value
On Error Resume Next
Application.ScreenUpdating = False
For i = LBound(liste) To UBound(liste)
    deg1 = Replace(liste(i, 1), "-", "")
    For j = i + 1 To Cells(65536, "A").End(xlUp).Row
        deg2 = Replace(liste(j, 1), "-", "")
        If deg1 > deg2 Then
            x = liste(i)
            liste(i, 1) = liste(j, 1)
            liste(j, 1) = x
        End If
    Next j
Next i
Range("A:A").ClearContents
Range("A1").Resize(UBound(liste), 1) = liste
Application.ScreenUpdating = True
MsgBox "Sıralama tamamlandı"
End Sub

 

[dEdE]

Merhaba,
Bir de aşağıdaki kodu dener misiniz. Eğer istediğinizi bu ise 2 saniyede yapıyor.
Yalnız geçici olarak B sütununu kullandiğını unutmayınız.

Sub Sırala()
    Columns("A:A").Select
    Selection.TextToColumns Range("A1"), Other:=True, OtherChar:="-", FieldInfo:=Array(Array(1, 1), Array(2, 1))
    ss = [A65536].End(3).Row
    Range("A1:B" & ss).Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("B1"), Order2:=xlAscending
    Range("A1").Select
For i = 1 To [A65536].End(3).Row
    Cells(i, 1).Value = Cells(i, 1).Value & "-" & Cells(i, 2).Value
Next
    Range("B:B").ClearContents
    MsgBox "İşlem Tamam.", , "dEdE İyi Günler Diler."
End Sub

 

[k.guclu]

Üstatlarım Evren Gizlen ve dEdE hocam çok teşekkür ederim. Elinize emeğinize sağlık gerçekten çok farklı ve güzel çözümler sundunuz. Ayrıca dEdE hocam son sunduğunuz çözüm çok güzel tekrardan hepinizin eline sağlık umarım diğer arkadaşlarımıza örnek teşkil eder.

Sağlık esenlik dolu günler dilerim.
___________________________________________________________________________
SAYGILARIMLA
K.GUCLU

 

[dEdE]

Rica ederim.
İşinize yaradığına sevindim.

Hoşça kalın.