Code Sort Bảng Tính

Liên hệ QC

vuongtoituonglai

Thành viên thường trực
Tham gia
7/5/14
Bài viết
350
Được thích
47
Chào anh chị và các bạn GPE,
Mình tìm trên diễn đàn được một đoạn code về việc Sort dữ liệu khá phù hợp công việc.
Tuy nhiên có một chỗ cần chỉnh sửa nhưng mình chưa thực hiện được.
Anh chị và các bạn GPE xem file và chỉnh sửa giúp mình với.

Chân thành cảm ơn
 

File đính kèm

  • GPE.xlsb
    21.2 KB · Đọc: 23
Chào anh chị và các bạn GPE,
Mình tìm trên diễn đàn được một đoạn code về việc Sort dữ liệu khá phù hợp công việc.
Tuy nhiên có một chỗ cần chỉnh sửa nhưng mình chưa thực hiện được.
Anh chị và các bạn GPE xem file và chỉnh sửa giúp mình với.

Chân thành cảm ơn
Cần chỉnh sửa chỗ nào bạn?
 
Upvote 0
Có 2 chỗ cần chỉnh như file đính kèm ấy bạn. Nếu bạn biết thì giúp đỡ mình với.
1. Sort dữ liệu
2. In selection
Phần in ấn chắc không làm được.
Sort thì có thể tạm xử lý được nhưng có lẽ bạn cần điền thêm số liệu mẫu vào bảng ghi nhận.
 
Upvote 0
Số liệu đã có trong file rồi đó bạn.
Phần sort, bạn thử code dưới đây.
(Chọn sheet định sort trước khi chạy)
Mã:
Sub SortMultiCols()
Dim SortRng As Range, Col(), i As Long, j As Long, k As Long, x, z, t
Dim rws As Long, cls As Long
Dim reg As Object
Set reg = CreateObject("VbScript.RegExp")
reg.Global = True
reg.Pattern = "\d+$"
Col = Array(6, 8, 2)
rws = [A65536].End(3).Row
cls = 2
For j = LBound(Col) To UBound(Col)
    ReDim t(5 To rws, 1 To 1)
    For i = 5 To rws
        If Cells(i, Col(j) + cls).Value <> "" Then
            If reg.test(Cells(i, Col(j) + cls).Value) Then
                If k < Len(reg.Execute(Cells(i, Col(j) + cls).Value)(0)) Then
                    k = Len(reg.Execute(Cells(i, Col(j) + cls).Value)(0))
                End If
                t(i, 1) = Len(reg.Execute(Cells(i, Col(j) + cls).Value)(0))
            Else
                t(i, 1) = 0
            End If
        Else
            t(i, 1) = 0
        End If
    Next i
    For i = 5 To rws
        If t(i, 1) > 0 Then
            x = Right(10 ^ k + CLng(Right(Cells(i, Col(j) + cls).Value, t(i, 1))), k)
            z = Left(Cells(i, Col(j) + cls).Value, Len(Cells(i, Col(j) + cls).Value) - t(i, 1)) & x
            Cells(i, Col(j) + cls).Value = z
        End If
    Next i
Next
Set SortRng = Range("B4", [B65536].End(3))
ActiveSheet.Sort.SortFields.Clear
With Worksheets("Sheet1").Sort
    For j = LBound(Col) To UBound(Col)
        .SortFields.Add SortRng.Offset(, Col(j))
    Next
   .SetRange SortRng.Resize(, 150)
   .Header = xlYes
   .SortMethod = xlPinYin
   .Apply
End With
End Sub
 
Upvote 0
Phần sort, bạn thử code dưới đây.
(Chọn sheet định sort trước khi chạy)
Mã:
Sub SortMultiCols()
Dim SortRng As Range, Col(), i As Long, j As Long, k As Long, x, z, t
Dim rws As Long, cls As Long
Dim reg As Object
Set reg = CreateObject("VbScript.RegExp")
reg.Global = True
reg.Pattern = "\d+$"
Col = Array(6, 8, 2)
rws = [A65536].End(3).Row
cls = 2
For j = LBound(Col) To UBound(Col)
    ReDim t(5 To rws, 1 To 1)
    For i = 5 To rws
        If Cells(i, Col(j) + cls).Value <> "" Then
            If reg.test(Cells(i, Col(j) + cls).Value) Then
                If k < Len(reg.Execute(Cells(i, Col(j) + cls).Value)(0)) Then
                    k = Len(reg.Execute(Cells(i, Col(j) + cls).Value)(0))
                End If
                t(i, 1) = Len(reg.Execute(Cells(i, Col(j) + cls).Value)(0))
            Else
                t(i, 1) = 0
            End If
        Else
            t(i, 1) = 0
        End If
    Next i
    For i = 5 To rws
        If t(i, 1) > 0 Then
            x = Right(10 ^ k + CLng(Right(Cells(i, Col(j) + cls).Value, t(i, 1))), k)
            z = Left(Cells(i, Col(j) + cls).Value, Len(Cells(i, Col(j) + cls).Value) - t(i, 1)) & x
            Cells(i, Col(j) + cls).Value = z
        End If
    Next i
Next
Set SortRng = Range("B4", [B65536].End(3))
ActiveSheet.Sort.SortFields.Clear
With Worksheets("Sheet1").Sort
    For j = LBound(Col) To UBound(Col)
        .SortFields.Add SortRng.Offset(, Col(j))
    Next
   .SetRange SortRng.Resize(, 150)
   .Header = xlYes
   .SortMethod = xlPinYin
   .Apply
End With
End Sub
Cảm ơn bạn,
Mình đã test thấy có vấn đề như sau:
1. Dữ liệu cột H bị thay đổi tự gán thêm giá trị VD như VT-1, VT-01 thì tất cả đổi thành VT-01-->sai
2. Có trường hợp dữ liệu Cột D cũng thay đổi, tự gán thêm giá trị
Bạn chỉnh lại giúp mình tất cả dữ liệu đều không được thay đổi ngoài việc sort tăng dần với các trường dữ liễu ưu tiên H, J, D
Ngoài ra Code chạy có cảm giác hơi chậm.

Cảm ơn bạn
 
Upvote 0
Cảm ơn bạn,
Mình đã test thấy có vấn đề như sau:
1. Dữ liệu cột H bị thay đổi tự gán thêm giá trị VD như VT-1, VT-01 thì tất cả đổi thành VT-01-->sai
2. Có trường hợp dữ liệu Cột D cũng thay đổi, tự gán thêm giá trị
Bạn chỉnh lại giúp mình tất cả dữ liệu đều không được thay đổi ngoài việc sort tăng dần với các trường dữ liễu ưu tiên H, J, D
Ngoài ra Code chạy có cảm giác hơi chậm.

Cảm ơn bạn
Có lẽ bạn chờ thành viên khác hỗ trợ vậy nhé.
Thân chào.
 
Upvote 0
Cảm ơn bạn,
Mình đã test thấy có vấn đề như sau:
1. Dữ liệu cột H bị thay đổi tự gán thêm giá trị VD như VT-1, VT-01 thì tất cả đổi thành VT-01-->sai
2. Có trường hợp dữ liệu Cột D cũng thay đổi, tự gán thêm giá trị
Bạn chỉnh lại giúp mình tất cả dữ liệu đều không được thay đổi ngoài việc sort tăng dần với các trường dữ liễu ưu tiên H, J, D
Ngoài ra Code chạy có cảm giác hơi chậm.

Cảm ơn bạn
Nếu sort theo 3 ưu tiên thì tạo thêm 3 cột phụ, Sort theo 3 cột phụ, xong xóa 3 cột này.
Ví dụ VT-1 thì trong cột phụ là VT-01, lúc này khi sort thì VT-01 không thể nằm kế VT-11 được.
 
Upvote 0
Nếu sort theo 3 ưu tiên thì tạo thêm 3 cột phụ, Sort theo 3 cột phụ, xong xóa 3 cột này.
Ví dụ VT-1 thì trong cột phụ là VT-01, lúc này khi sort thì VT-01 không thể nằm kế VT-11 được.
Cảm ơn bác Ba Tê. Bác giúp đỡ mình phần code In như bài #1 mình nêu trong file.
 
Upvote 0
Dữ liệu ngoài dạng VT-x (x là số) còn dạng nào không bạn. Nếu chỉ có vậy thì thêm lệnh Replace VT- thành chuỗi rỗng rồi sort, sort rồi thì lại thêm vào. Nếu ngoài dạng trên còn cả dạng ABC-x nữa thì bạn thêm cột phụ.
 
Upvote 0
Dữ liệu ngoài dạng VT-x (x là số) còn dạng nào không bạn. Nếu chỉ có vậy thì thêm lệnh Replace VT- thành chuỗi rỗng rồi sort, sort rồi thì lại thêm vào. Nếu ngoài dạng trên còn cả dạng ABC-x nữa thì bạn thêm cột phụ.
Quý vị kiên nhẫn thật. Tôi nhìn thấy VT-1 và VT-01 là kết luận "dữ liệu rác rưởi" và không muốn làm gì nữa.
 
Upvote 0
Dữ liệu ngoài dạng VT-x (x là số) còn dạng nào không bạn. Nếu chỉ có vậy thì thêm lệnh Replace VT- thành chuỗi rỗng rồi sort, sort rồi thì lại thêm vào. Nếu ngoài dạng trên còn cả dạng ABC-x nữa thì bạn thêm cột phụ.
Quý vị kiên nhẫn thật. Tôi nhìn thấy VT-1 và VT-01 là kết luận "dữ liệu rác rưởi" và không muốn làm gì nữa.
Sao bác lại nói là " dữ liệu rác rưởi ". Đôi khi có những dữ liệu không phải do mình tạo ra mà phải nhận từ người khác để sử dụng thì phải chấp nhận bác ah.
 
Upvote 0
Mình tiến hành ghi macro sắp xếp đây, bạn thử tham khảo:
PHP:
Sub LocTheoCotPhu()
    Range("L4").Select
    ActiveCell.FormulaR1C1 = "Ddiem"
    Range("L5").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(LEN(RC[-4])<5,LEFT(RC[-4],3) & ""0"" & RIGHT(RC[-4],1),RC[-4])"
    Range("L5").Select
    Selection.AutoFill Destination:=Range("L5:L11")
    Range("B4:L11").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("L5:L11") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("H5:H11") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("D5:D11") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("B4:L11"):                  .Header = xlYes
        .MatchCase = False:                         .Orientation = xlTopToBottom
        .SortMethod = xlPinYin:                     .Apply
    End With
End Sub

Phần in ấn bạn tiếp tục chờ người khác giúp đi nha,. . .
 
Upvote 0
Mình tiến hành ghi macro sắp xếp đây, bạn thử tham khảo:
PHP:
Sub LocTheoCotPhu()
    Range("L4").Select
    ActiveCell.FormulaR1C1 = "Ddiem"
    Range("L5").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(LEN(RC[-4])<5,LEFT(RC[-4],3) & ""0"" & RIGHT(RC[-4],1),RC[-4])"
    Range("L5").Select
    Selection.AutoFill Destination:=Range("L5:L11")
    Range("B4:L11").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("L5:L11") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("H5:H11") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("D5:D11") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("B4:L11"):                  .Header = xlYes
        .MatchCase = False:                         .Orientation = xlTopToBottom
        .SortMethod = xlPinYin:                     .Apply
    End With
End Sub

Phần in ấn bạn tiếp tục chờ người khác giúp đi nha,. . .
Mình cảm ơn bác SA_DQ
 
Upvote 0
Web KT
Back
Top Bottom