- Katılım
- 17 Mayıs 2012
- Mesajlar
- 102
- Excel Vers. ve Dili
- Office 2019, Türkçe
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub Deneme()
Dim i As Long
Dim j As Long
j = Cells(Rows.Count, "A").End(3).Row
i = 1
Application.ScreenUpdating = False
Do Until Cells(i, "A") <> ""
i = i + 1
Loop
Do
Range("A" & i & ":B" & i + 3).Sort Key1:=[B1], order1:=2
i = i + 4
i = Range("A" & i).End(xlDown).Row
Loop While i < j
Application.ScreenUpdating = True
MsgBox "İşlem Bitmiştir ...."
End Sub
Option Explicit
Sub Sort_Blocks_Z_A()
Dim Rng As Range
Application.ScreenUpdating = False
For Each Rng In Range("A:B").SpecialCells(xlCellTypeConstants)
If Rng.Column = 1 Then
Rng.CurrentRegion.Sort Rng.Columns(2), xlDescending
End If
Next
Application.ScreenUpdating = True
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub