Code Sort Bảng Tính

vuongtoituonglai

Thành viên thường trực
Tham gia ngày
7 Tháng năm 2014
Bài viết
337
Được thích
48
Điểm
385
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

CHAOQUAY

Thành viên tích cực
Tham gia ngày
24 Tháng tám 2018
Bài viết
1,084
Được thích
1,132
Điểm
360
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?
 

CHAOQUAY

Thành viên tích cực
Tham gia ngày
24 Tháng tám 2018
Bài viết
1,084
Được thích
1,132
Điểm
360
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.
 

CHAOQUAY

Thành viên tích cực
Tham gia ngày
24 Tháng tám 2018
Bài viết
1,084
Được thích
1,132
Điểm
360
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
 

vuongtoituonglai

Thành viên thường trực
Tham gia ngày
7 Tháng năm 2014
Bài viết
337
Được thích
48
Điểm
385
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
 

CHAOQUAY

Thành viên tích cực
Tham gia ngày
24 Tháng tám 2018
Bài viết
1,084
Được thích
1,132
Điểm
360
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.
 

Ba Tê

Gội Rồi Mới Cạo
Tham gia ngày
5 Tháng năm 2009
Bài viết
11,487
Được thích
16,395
Điểm
1,860
Tuổi
61
Nơi ở
An Giang
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.
 

vuongtoituonglai

Thành viên thường trực
Tham gia ngày
7 Tháng năm 2014
Bài viết
337
Được thích
48
Điểm
385
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.
 

Hau151978

Thành viên tích cực
Tham gia ngày
19 Tháng mười 2011
Bài viết
1,346
Được thích
1,235
Điểm
560
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ụ.
 

VetMini

Chuyên gia GPE
Tham gia ngày
21 Tháng mười hai 2012
Bài viết
8,917
Được thích
10,441
Điểm
1,560
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.
 

vuongtoituonglai

Thành viên thường trực
Tham gia ngày
7 Tháng năm 2014
Bài viết
337
Được thích
48
Điểm
385
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.
 

SA_DQ

/(hông là gì!
Thành viên danh dự
Tham gia ngày
8 Tháng sáu 2006
Bài viết
11,397
Được thích
17,305
Điểm
1,860
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,. . .
 

vuongtoituonglai

Thành viên thường trực
Tham gia ngày
7 Tháng năm 2014
Bài viết
337
Được thích
48
Điểm
385
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
 
Top Bottom