รบกวนเขียน VBA ให้หน่อยครับ

[4ko6yon61]

ต้องการ
เรียงข้องมูล A1:B400 ครับ
ช่วงแรก 100 ชุด เรียงข้อมูลตามคอลัมน์ B จากค่ามากไปน้อย (คละ Group)
ช่วงสอง 20 ชุด เรียงข้อมูลตามคอลัมน์ A จากค่ามากไปน้อย และ คอลัมน์ B จากค่ามากไปน้อย (ต้องการเฉพาะ Group B )
ช่วงที่สาม 280 ชุด เรียงข้อมูลตามคอลัมน์ B จากค่ามากไปน้อย (คละ Group)

ขอบคุณมากครับ

[Supachok]

Code: Select all

Sub Macro1()
'
' Macro1 Macro
'

'

    Range("A1:B100").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B1:B100") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:B100")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
End With
    Range("A101").Select
    ActiveWindow.SmallScroll Down:=282
    Range("A101:B400").Select
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range( _
        "A101:A400"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range( _
        "B101:B400"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A101:B400")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
End With
    Range("A121:B400").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range( _
        "B121:B400"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A121:B400")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
End With


End Sub

เป็น code marco เดี๋ยวอาจมีท่านอื่นมาช่วยปรับ VBA จะกระชับขึ้น

[4ko6yon61]

ขอบคุณมากครับ แต่ขอเพิ่มเติมนิดได้ไหมครับ มีเงื่อนไขเพิ่มขึ้นมา

คือ ช่วงแรก 100 ชุด หากเรียงแล้วลำดับถัดจาก B100 มีค่าในคอลัมน์ B เท่ากับ ลำดับ B100 ก็ให้นับรวมเป็นช่วงแรก ซึ่งอาจมี 100+ ชุด
ช่วงที่สอง ก็เช่นกัน อาจมีมากกว่า 20 ชุด

ขอบคุณอีกครั้งครับ

[snasui]

VBA ต้องเขียนกันมาเอง ติดแล้วค่อยถามกัน อ่านกฎการใช้บอร์ดทุกข้อด้านบนอีกรอบครับ