سورت اتوماتیک در اکسل

[~M*E*H*D*I~]

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "A:A"
Dim LastRow As Long
Dim i As Long
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
Me.Columns(1).Sort key1:=Me.Range("A1"), _
order1:=xlAscending, _
Header:=False
LastRow = Me.Cells(Me.Rows.Count, .Column).End(xlUp).Row
For i = LastRow To 1 Step -1
If Me.Cells(i, .Column).Value = Me.Cells(i - 1, .Column).Value Then
Me.Rows(i).Delete
End If
Next i
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub 

[~M*E*H*D*I~]

درود

دوستان لطفا کدی که تو پست اول اومده برای محدوده بیشتری توسعه بدند

[Amir Ghasemiyan]

ممنون از كدي كه گذاشتي مهدي جان فقط يك مشكل داره
داده هاي تكراري رو حذف ميكنه
براي رنج هاي متفاوت هم بايد از يك همچين ساختاري استفاده كرد ولي دقيقشو نميدونم

"a:a,b:b,f:f"

[mokaram]

برای جاهایی که بخواهیم داده تکراری وارد نشه و سورت هم بشه خیلی عالیه ممنون آقا مهدی

[mokaram]

یه فایلی پیدا کردم که درباره همین موضوعه و مشکل ورود داده تکراری را هم نداره (فقط من یه مشکلی با این فایل ولی چون اینجا تالار آموزش هست اینجا مطرح نمی کنم . دیدید پسر خوبی شدم ) ( مشکل را اینجا ببینید http://forum.exceliran.com/showthrea...2911#post22911 )