Sıralama Makrosunda 1. ile 10. sayıları sıralatma

[ferhatgurbuz]

Sıralama Makrosunda hata

Kolay gelsin arkadaşlar. Aşağıdaki kod ile C sutununda sıralam yaptırırken 1.den sonra 10. yu sıralatıyor. Yani 1.,2.,3., 9. 10. 11. şeklinde olması gerekirken 1.,10. 2., 3., şeklinde geliyor.yardımlarınızı bekliyorum. iyi çalışmalar


Option Explicit

Sub Sırala()
Dim i As Long, son As Long
Application.ScreenUpdating = False
On Error Resume Next
son = [B65536].End(3).Row
For i = 3 To son
Cells(i, "G") = Split(Cells(i, "C"), ".")(1) & _
Application.Rept("a", Split(Cells(i, "C"), ".")(0))
Next i
Range("B3:G" & son).Sort Key1:=Range("F3"), Key2:=Range("G3")
Range("G3:G" & son).ClearContents
Application.ScreenUpdating = True
End Sub

 

[halit3]

alternatif kod

Sub Sırala()
On Error Resume Next
sat = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
sut = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range(Cells(1, 1), Cells(sat, sut)).Select
Application.Dialogs(39).Show
Range("a1").Select
End Sub

yada sıralanacak bölümü seçin aşağıdaki kodu deneyiniz.

Sub Sırala1()
Application.Dialogs(39).Show
Range("a1").Select
End Sub

 

[halit3]

yukarıdaki mesajdaki koda ilave yaptım.

 

[ferhatgurbuz]

Sıralama Kodu

örnek dosya ektedir. Ben denedim ama olmadı.

 

[halit3]

evet göndermiş olduğum kod A1 den süzme işlemine başlıyordu sizinki A3 den başlıyor

aşağıdaki kodu denermisiniz.

Sub Sırala()
On Error Resume Next
sat = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
sut = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range(Cells(3, 1), Cells(sat, sut)).Select
MsgBox sat
Application.Dialogs(39).Show
Range("a1").Select
End Sub

 

[ferhatgurbuz]

Halit hocam maalesef olmuyor.

 

[halit3]

ekli dosyada düğmeye tıkla aşılan formdan bir defaya mahsus sıralama yapacağın sütünu seç sonra tamam diyeceksiniz.

 

[halit3]

örnek olarak açılan formdan başlık satırı yok seçeneğini işaretle
sonra sutünc yi seç ve tamamı tıkla

 

[ferhatgurbuz]

Halit hocam ya benim bilgisayarda sorun var yada yanlış anlaşılıyorum. Sizin yaptığınızı ben bilgisayarda yaptığımda yine 1.İdare Mahkemesinden sonra gene 10.İdare Mahkemesi yada 11.Vergi Mahkemesi geliyor. 10. ve ya 11. mahkemelerin 9. dan sonra gelmesi lazım

 

[halit3]

sıralama yaptığınız sutün sayısal veri değil metin onun için başdaki sayılar doğrultusunda süzme işlemi yapmaz bunu metin olarak algılar

 

[halit3]

excelin bir özelliğinden bahsedeyim.

öncelikle sıralama yapacağın sutündaki bilgileri manuel olarak diz daha sonra

araçlar\seçenekler\özellistelir verial ın yanındaki seçenek kutusundan sıralama yapacağın c sütutundaki bilgileri seç sonra verial düğmesini tıkla özel listeler bölümüne eklenecektir orada gözükür yani pazartesi,salı gibi

bundan sonra makro kodunu çalıştır açılan formdan başlık satırı yok işaretle seçenekler düğmesini tıkla açılan liste kutusundan kayıt yapmış olduğun bölümü seç tamamı tıkla sonra sıralama yapacağın sutünc yi seç tamamı tıkla

 

[ferhatgurbuz]

Peki nasıl çözeriz bu sorunu. Başka bir yol varmıdır.

 

[halit3]

ekli dosyaya bir bak resimli anlatım var birde G suütnu yardımcı sutün kullanılmıştır kullanıcı tanımlı fonksiyon vardır.

 

[halit3]

resimleri yeniden ekledim kontdol ediniz.

 

[ferhatgurbuz]

Halit hocam zahmet oldu size. Bağlantıda bir problem var zannedersem. Mesajlar geç gidiyor. O konuyu anladım. Ama daha pratik birşey lazım. Bir buton ile olacak birşey. Benim aklıma şöyle birşey geldi. Ama uygulamada nasıl olur bilemiyorum.
Yardımcı sutuna bir formül yazsak
=EĞER(C2="1.İdare Mahkemesi";1;EĞER(C2="2.İdare Mahkemesi";2;EĞER(C2="3.İdare Mahkemesi";3;EĞER(C2="4.İdare Mahkemesi";4))) şeklinde bütün mahkemeleri bu şeklide formüle edip sonra formül sutununu sıralatsak diyorum.

Yada sayılar için şöyle bir kod vardı bunu metin için yapsak olurmu

Function Fon(değer As Long)
If değer = 0 Then Fon = 2
If değer = 25 Then Fon = 2
If değer = 41 Then Fon = 10
If değer = 43 Then Fon = 10
End Function

 

[halit3]

G sütunu yardımcı olarak kullanılmıştır.

Sub Makro1()
For i = 3 To Cells(Rows.Count, "C").End(3).Row
Cells(i, "G").Value = Val(Cells(i, "c").Value)
Next
ad = Cells(Rows.Count, "C").End(3).Row
ra = 3 & ":"
Rows(ra & ad).Select
TA = 7
YA = ra & ad
Rows(YA).Sort Key1:=Cells(TA), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A1").Select
End Sub

 

[ferhatgurbuz]

Halit hocam hakkınızı helal edin. Belki bana kızıyorsunuz dur ama. İnannın bende üzgünüm. Normalde Excel sıralama yaparken önce idareleri sonra vergileri sıralatıyordu. Ben size onu söylemeyi unuttum. Yani iki basamaklıları dahil etmeseydik bu şekilde olacaktı. Eğer o şekilde olursa çok güzel olacak. Yani önce 1 den 10 kadar idare mahkemeleri, sonra 1 den 11 e kadar vergi mahkemeleri şeklinde.

 

[halit3]

bu kodu denermisiniz.
g ve h sutünları yardımcı olarak kullanılmıştır.

Sub Sırala()
son = Cells(Rows.Count, "C").End(3).Row
For i = 1 To son
Cells(i, "h").Value = Val(Cells(i, "c").Value)
say = ""
For j = 1 To Len(Cells(i, "c").Value)
Sayi = Mid(Cells(i, "c").Value, j, 1)
If IsNumeric(Sayi) <> True Then
If Sayi <> "." Then
say = say & Sayi
End If
End If
Next j
Cells(i, "g").Value = say
Next i
sat = 3 & ":"
Rows(sat & son).Select
sut1 = 8
sut2 = 7
sutün = sat & son
Rows(sutün).Sort Key1:=Cells(sut1), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A1").Select
For i = 1 To son
Cells(i, "g").Value = Format(SAYILARIBUL(Cells(i, "c").Value), "00")
Cells(i, "h").Value = RAKAMLARIBUL(Cells(i, "c").Value)
Next i
Rows(sutün).Sort Key1:=Cells(sut2), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A1").Select
Makro3
Rows(sutün).Sort Key1:=Cells(sut1), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A1").Select

For i = 1 To son
Cells(i, "h").Value = ""
Cells(i, "g").Value = ""
Next i
End Sub