sao em bấm sắp xếp mà nó sắp xếp lộn xộn vậy?

Chào bạn bạn xem đang sắp xếp theo cột nào?

Cột Khu Vực á thầy. Thầy xem lại cho em cái code với

Sub test()

'

' Test Macro

'

'Chon o A1

    Range("A1").Select

'Nhap chu vao Ten vao

    ActiveCell.FormulaR1C1 = "Ten"

    Range("A2").Select 'Chon o A2

    ActiveCell.FormulaR1C1 = "A"

    Range("A3").Select

    ActiveCell.FormulaR1C1 = "B"

    Range("A4").Select

    ActiveCell.FormulaR1C1 = "C"

    Range("A5").Select

    ActiveCell.FormulaR1C1 = "D"

    Range("B1").Select

    ActiveCell.FormulaR1C1 = "So luong"

    Range("B2").Select

    ActiveCell.FormulaR1C1 = "1"

    Range("B3").Select

    ActiveCell.FormulaR1C1 = "2"

    Range("B4").Select

    ActiveCell.FormulaR1C1 = "3"

    Range("B5").Select

    ActiveCell.FormulaR1C1 = "4"

    Range("B6").Select

    ActiveCell.FormulaR1C1 = "=SUM(R[-4]C+R[-3]C+R[-2]C+R[-1]C)"

    Range("A1:B6").Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .ColorIndex = xlAutomatic

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .ColorIndex = xlAutomatic

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .ColorIndex = xlAutomatic

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .ColorIndex = xlAutomatic

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .ColorIndex = xlAutomatic

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideHorizontal)

        .LineStyle = xlContinuous

        .ColorIndex = xlAutomatic

        .TintAndShade = 0

        .Weight = xlThin

    End With

    MsgBox "Ok"

End Sub

Sub Macro2()

'

' Macro2 Macro

'

'

    Range("A2:A20").Select

    ActiveSheet.Range("$A$1:$A$20").RemoveDuplicates Columns:=1, Header:=xlYes

    Range("B1").Select

    MsgBox "Xóa trùng thành công!"

End Sub

Sub Macro3()

'

' Macro3 Macro

'

'

    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Clear

    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range("A2"), _

        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    With ActiveWorkbook.Worksheets("Sheet2").Sort

        .SetRange Range("A2:A13")

        .Header = xlYes

        .MatchCase = False

        .Orientation = xlTopToBottom

        .SortMethod = xlPinYin

        .Apply

    End With

End Sub

Sub Macro4()

'

' Macro4 Macro

'

'

    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Clear

    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range("A2"), _

        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    With ActiveWorkbook.Worksheets("Sheet2").Sort

        .SetRange Range("A2:A10")

        .Header = xlYes

        .MatchCase = False

        .Orientation = xlTopToBottom

        .SortMethod = xlPinYin

        .Apply

    End With

End Sub

Chào bạn bạn vui lòng dẩy file lên nhé, code không có dữ liệu không thể biết được đang bị lỗi ở đâu nhé.

Thầy ơi e sai ở đâu mà e ấn bỏ trùng nó ko chạy

Sub Macro2()
'
' Macro2 Macro
'

'
    Range("A1:A20").Select
    ActiveSheet.Range("$A$1:$A$8").RemoveDuplicates Columns:=1, Header:=xlYes
    ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, 147, 19.2, 118.2, 49.8). _
        Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "b? trùng"
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 8). _
        ParagraphFormat
        .FirstLineIndent = 0
        .Alignment = msoAlignLeft
    End With
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).Font
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorLight1
        .Fill.ForeColor.TintAndShade = 0
        .Fill.ForeColor.Brightness = 0
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 11
        .Name = "+mn-lt"
    End With
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(3, 6).Font
        .BaselineOffset = 0
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorLight1
        .Fill.ForeColor.TintAndShade = 0
        .Fill.ForeColor.Brightness = 0
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 11
        .Name = "+mn-lt"
    End With
    Selection.OnAction = "Macro2"
    Range("A8").Select
    ActiveCell.FormulaR1C1 = "Tp HCM"
    Range("A9").Select
    ActiveCell.FormulaR1C1 = "Qu?ng Ninh"
    Range("A10").Select
    ActiveCell.FormulaR1C1 = "Hu?"
    Range("A2:A13").Select
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 1")).Select
    Selection.OnAction = "Macro2"
    Range("A2:A11").Select
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 1")).Select
    Selection.OnAction = "Macro2"
    Range("A2").Select
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 1")).Select
    Range("A2:A12").Select
End Sub

Chào bạn với câu lệnh bỏ trùng bạn chỉ cần như sau:

Option Explicit
Sub Botrung()
    Range("A1:A20").Select
    ActiveSheet.Range("$A$1:$A$15").RemoveDuplicates Columns:=1, Header:=xlYes
End Sub