مرتب کردن جدول

**amir_ts** · 2016/08/08, 16:07

با سلام
فایل نمونه رو ملاحظه کنید.با استفاده از یک ستون کمکی (A) و ماکرو انجام شده است.
در صورت درج عبارت تسویه در ستون I مرتب سازی صورت میگیرد.

کد:

[LEFT]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 9 Then
 Columns("A:A").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A:I")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    End If
End Sub


[/LEFT]

فایل های پیوست شده

sort.rar (19.1 کیلو بایت, مشاهدات 15)

**mhmd.q** · 2016/08/08, 16:45

نوشته اصلی توسط amir_ts

با سلام
فایل نمونه رو ملاحظه کنید.با استفاده از یک ستون کمکی (A) و ماکرو انجام شده است.
در صورت درج عبارت تسویه در ستون I مرتب سازی صورت میگیرد.

کد:

[LEFT]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 9 Then
 Columns("A:A").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A:I")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    End If
End Sub


[/LEFT]

خیلی ممنون دوست عزیز♥چرا من نمیتونم فایل پیوست رو ببینم؟!

فرستاده شده از GT-I9300ِ من با Tapatalk

**amir_ts** · 2016/08/08, 16:49

شما یاید نرم افزار مربوطه برای خارج کردن از حالت فشرده رو داشته باشید.(WinRAR )

**mhmd.q** · 2016/08/08, 16:52

نوشته اصلی توسط amir_ts

شما یاید نرم افزار مربوطه برای خارج کردن از حالت فشرده رو داشته باشید.(WinRAR )

اخه هیج یک از فرمتهارو برام باز نمیکنه حتی xls.برنامه office هم نصب کردم تو گوشیم ولی اجرا نمیشع

فرستاده شده از GT-I9300ِ من با Tapatalk

**mhmd.q** · 2016/08/08, 16:56

نرافزار winrar هم نصب کردم بازم باز نمیکنه

فرستاده شده از GT-I9300ِ من با Tapatalk

**mhmd.q** · 2016/08/09, 11:06

نوشته اصلی توسط amir_ts

با سلام
فایل نمونه رو ملاحظه کنید.با استفاده از یک ستون کمکی (A) و ماکرو انجام شده است.
در صورت درج عبارت تسویه در ستون I مرتب سازی صورت میگیرد.

کد:

[LEFT]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 9 Then
 Columns("A:A").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A:I")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    End If
End Sub


[/LEFT]

دوست عزیز این کدی که دادین رو من زدم ولی ارور داد میشع راهنماییم بکنید لطفا.
خط پنج و شیش کد رو اخطار داده

فرستاده شده از GT-I9300ِ من با Tapatalk

**iranweld** · 2016/08/09, 11:16

در رنج a1 شیت مورد نظر کلمه فارسی با حرف "ی" دارید؟

**amir_ts** · 2016/08/09, 11:17

با سلام
خط دوم زرد رنگ .clear در کد ارسالی بنده وجود نداره.

**mhmd.q** · 2016/08/09, 11:26

نوشته اصلی توسط amir_ts

با سلام
خط دوم زرد رنگ .clear در کد ارسالی بنده وجود نداره.

بله درست شد.الان من روی یکی از سلول های ستون i کلیک میکنم منو میبره رو ستون A.طبق عکس من میخوام وقتی روی یکی از سلول های ستون N بنویسم تصفیه سطر شرکت ارد درخشان انتقال پیدا بکنه به پایین جدول یعنی پایین جدول اون شرکتهایی باشند که تصفیه شدن.میشه راهنماییم کنید لطفا

فرستاده شده از GT-I9300ِ من با Tapatalk

**mhmd.q** · 2016/08/09, 11:29

نوشته اصلی توسط iranweld

در رنج a1 شیت مورد نظر کلمه فارسی با حرف "ی" دارید؟

درست شد دوست عزیز♥♥

فرستاده شده از GT-I9300ِ من با Tapatalk

**amir_ts** · 2016/08/09, 12:17

الان من روی یکی از سلول های ستون i کلیک میکنم منو میبره رو ستون A.طبق عکس من میخوام وقتی روی یکی از سلول های ستون N بنویسم تصفیه سطر شرکت ارد درخشان انتقال پیدا بکنه به پایین جدول یعنی پایین جدول اون شرکتهایی باشند که تصفیه شدن.میشه راهنماییم کنید لطفا

تغییرات لازم در کد اعمال شد.

کد:

[LEFT]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 14 Then
Columns("A:A").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:N50")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    End If
End Sub




[/LEFT]

**mhmd.q** · 2016/08/09, 13:46

نوشته اصلی توسط amir_ts

تغییرات لازم در کد اعمال شد.

کد:

[LEFT]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 14 Then
Columns("A:A").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:N50")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    End If
End Sub




[/LEFT]

خیلی خیلی ممنون دوست گرامی♥♥♥♥

فرستاده شده از GT-I9300ِ من با Tapatalk

**mhmd.q** · 2016/08/09, 14:37

نوشته اصلی توسط amir_ts

تغییرات لازم در کد اعمال شد.

کد:

[LEFT]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 14 Then
Columns("A:A").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:N50")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    End If
End Sub




[/LEFT]

سلام دوست عزیز ببخشید بازم مزاحم شدم.من کد رو وارد کردم طبق عکس من وقتی کلمه تصفیه رو در سطری که شرکت تصفیه کرده مینویسم شرکت انتقال پیدا نمیکنه به پایین جدول میشه لطفا بازم راهنماییم کنید؟!یجور دستور باشه که وقتی جلوی شرکت مینویسم تصفیه انتقال پیدا کنه به اخره جدول.ممنون میشم راهنماییم کنید دوست عزیز♥

فرستاده شده از GT-I9300ِ من با Tapatalk

**iranweld** · 2016/08/09, 15:09

با سلام

فایل پیوست را ملاحظه بفرمایید.

کد PHP:


Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Me.Range("N:N")) Is Nothing Then
    
    
   If Target = ChrW(1578) & ChrW(1587) & ChrW(1608) & ChrW(1740) & ChrW(1607) _
   Then
   
   Application.EnableEvents = False
   
   X1 = Target.Row
   
   X2 = Cells(Rows.Count, "A").End(xlUp).Row + 1
   
    Rows(X1 & ":" & X1).Cut
   
   
   Rows(X2 & ":" & X2).Insert Shift:=xlDown
   
   
   Application.EnableEvents = True
   
   
   End If
 
    End If
    
    End Sub