DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Selamlar, "A" sütunundaki kelimeleri kelimelerin harf sayısına göre sıralamak mümkünmü.
Yardımlarınız için şimdiden teşekkürler...
Option Explicit
Sub uzunluk_sırala_61()
Dim ts, trabzonspor, süre
trabzonspor = MsgBox("Harf Sayısına Gçre Sıralıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
süre = Time
For ts = 1 To Cells(Rows.Count, "A").End(xlUp).Row
Cells(ts, "B") = Len(Cells(ts, "A"))
Next
Range("A:B").Sort key1:=Range("B1"), order1:=xlAscending
Range("B:B").ClearContents
MsgBox Format(süre - Time, "hh:mm:ss") & " Sürede Tamamladım", vbInformation, "Bitiş"
End Sub
Sub siralat_59(ByVal sut As Byte)
Dim sat As Long
sat = Cells(65536, "A").End(xlUp).Row
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If sat < 2 Then Application.ScreenUpdating = True: Exit Sub
Range("A2:B" & sat).Sort Cells(2, sut)
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub boysirasi()
For i = 1 To Range("a65536").End(3).Row
Cells(i, 2) = Left(Cells(i, 1), 1) & Format(Len(Cells(i, 1)), "00") & "_" & Cells(i, 1)
Next
Columns("B:B").Select
ActiveWorkbook.Worksheets("Sayfa1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sayfa1").Sort.SortFields.Add Key:=Range("B1") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sayfa1").Sort
.SetRange Range("A:B")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("B:B").ClearContents
End Sub
Şehir dışına çıkmam gerekti o yüzden geç bakabildim. Hepinize çok teşekkür ederim. tam istediğim gibi olmuş. Saygılar selamlar..