در خواست کمک از مدیران،

[ali_121]

سلام به همه مدیران عزیز،

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

[امين اسماعيلي]

با درود
دوست من نمیدونم کارت رو تا اینجا داری درست انجام داددی یا نه. اما کار دومت با ستور if قابل انجام هست فرضا

if sheet1.range("A1").value=sheet1.range("b1").value then
دستورات سورت که که میخواین
else
سورت اولی 
end if

[ali_121]

سلام دوست عزیز
1- این دستورات به درستی دارن کار میکنن
2- جدول به صورت ستونی هست و سورت به اون صورتـه که کلا در یک شیت قرار دارن
3- میخوام سورت ستونها بهم نخوره (تعداد ردیفها زیاده) وقتی مساوی بودن فقط کمی تغییر کنه
متشکرم

[khakzad]

سلام دوست عزیز.
ببینید برداشت بنده از سوال شما درسته؟
مثلا دو ستون دارید.ستون اول نام بانک (که هرکدوم مثلا 10-12 بار تکرار شدن و پراکنده. ستون دوم مبلغ وام)
حالا می خواید اول نام بانک ها رو مرتب کنید.تا اینجا که اوکی.همون دستور اولیه سورت هست.
حالا م یخواید بین بانک های مشابه مبلغ وام رو بصورت نزولی مرتب کنید.
خب اینجا هم خیلی ساده هست.شما باید ابزار سورت رو باز کنید.add ;evel رو بزنید و در اون level سرستون مربوط به قیمت رو انتخاب کنید و گزینه نزولی رو بزنید.
حالا باز اگر قیمت های مساوی داشتید می تونید یک سطح دیگه اضافه کنید و قیمت های مشابه رو مثلا بر اساس زمان مرتب کنید (با فرض اینکه ستون زمان داشته باشید)
در واقع ماهیت وجود چندین سطح در سورت همین هست و فقط در این خصوص استفاده میشه.ویژه داده های تکراری هست

امیدوارم مفید باشه

[ali_121]

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

[khakzad]

این ماکرو رو ضبط کردم کدها رو بببینید:

 ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("[COLOR=#ff0000]A1:A34[/COLOR]") _
        , SortOn:=[COLOR=#ff0000]xlSortOnValues[/COLOR], Order:=[COLOR=#ff0000]xlAscending[/COLOR], DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B1:B34") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("C1:C34") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:C34")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

اگر دقت کنید می بینید قبل از WITH شروط رو آورده.اول ستون a بعد b و بعد و مشخصاتی که برای هر شرط مطرحه (صعودی، نزولی و . . .)مشخصات یکی از شرط ها رو قرمز کردم راحت تر ببینید.
از with هم که مشخصات کلی سورت رو می بینید .اینکه دیتا header داره یا نه و . . . .
حالا شما با توجه به داده های خودتون، نام شیت، محدودهف شروط و . . . رو تغییر بدید و ماکرو خودتون رو ران کنید.
سوالی بود در خدمتم
موفق باشید

[ali_121]

این ماکرو رو ضبط کردم کدها رو بببینید:

 ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("[COLOR=#ff0000]A1:A34[/COLOR]") _
        , SortOn:=[COLOR=#ff0000]xlSortOnValues[/COLOR], Order:=[COLOR=#ff0000]xlAscending[/COLOR], DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B1:B34") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("C1:C34") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:C34")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

اگر دقت کنید می بینید قبل از WITH شروط رو آورده.اول ستون a بعد b و بعد و مشخصاتی که برای هر شرط مطرحه (صعودی، نزولی و . . .)مشخصات یکی از شرط ها رو قرمز کردم راحت تر ببینید.
از with هم که مشخصات کلی سورت رو می بینید .اینکه دیتا header داره یا نه و . . . .
حالا شما با توجه به داده های خودتون، نام شیت، محدودهف شروط و . . . رو تغییر بدید و ماکرو خودتون رو ران کنید.
سوالی بود در خدمتم
موفق باشید

دکمه سپاس کم بود خواستم از دوست عزیز خاکزاد تشکر ویژه کرده باشم
مشکلم به کلی حل شد با راهنمایی که دوست عزیز کردند
متشکرم

[mokaram]

ببخشید که اینجا مطرح کردم نمیدونم چرا نمیتونم پست جدید بدم
به هرحال موضوع سوالم مشترک با این پست هستش:
تو فایل پیوست میخوام اگه هر عددی را تو باکس تکرار وارد کردم به همون تعداد اطلاعات را زیر هم تو شیت یک ثبت کنه به عبارت ساده تر: من اطلاعات را تو تکست باکسها وارد میکنم بعد تو خونه تکرار به طور مثال عدد 3 را وارد میکنم بعد دکمه ثبت را که میزنم اطلاعات سه بار تو شیت یک زیر هم نوشته بشه
ممنون

[Nima]

ببخشید که اینجا مطرح کردم نمیدونم چرا نمیتونم پست جدید بدم
به هرحال موضوع سوالم مشترک با این پست هستش:
تو فایل پیوست میخوام اگه هر عددی را تو باکس تکرار وارد کردم به همون تعداد اطلاعات را زیر هم تو شیت یک ثبت کنه به عبارت ساده تر: من اطلاعات را تو تکست باکسها وارد میکنم بعد تو خونه تکرار به طور مثال عدد 3 را وارد میکنم بعد دکمه ثبت را که میزنم اطلاعات سه بار تو شیت یک زیر هم نوشته بشه
ممنون

میتونید از کد زیربرای دکمه ثبت استفاده کنید:

Private Sub CommandButton1_Click()
Dim X As Integer
Dim nextrow As Range
Dim cNum As Integer


Set nextrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)


cNum = 4
For i = 1 To TextBox5.Value
    For X = 1 To cNum
        nextrow = Me.Controls("TextBox" & X).Value
        Set nextrow = nextrow.Offset(0, 1)


        If X = cNum Then
            Set nextrow = nextrow.Offset(1, -4)
        End If
    Next
Next i
End Sub

[mokaram]

آقا نیما ارور میده به خط چهار اونجایی که با set شروع میشه

[Nima]

فایل ضمیمه رو مشاهده بفرمائید: