viết code trong excel để sắp xếp theo yêu cầu sau đó tách sheet (6 người xem)

  • Thread starter Thread starter thufpts
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
T

thufpts

Thành viên hoạt động
Tham gia
6/8/12
Bài viết
157
Được thích
6
Giới tính
Nam
Nghề nghiệp
Bốc vác
em chào các bác!
em có một file excel có các cột ở dòng số 8 được đánh thứ tự ưu tiên và mong muốn được sắp xếp theo các điều kiện sau nhờ các bác, anh chị giúp đỡ
1) cột E, W, AC các dữ liệu giống nhau thì được sắp xếp cùng nhau theo thứ tự ưu tiên đã đánh đâu ở dòng số 8, cột G sắp xếp tăng dần ví dụ
ví dụ kết quả như sau khi bấm nút "sap xep" sẽ sắp xếp MACHINE có 7 dòng giá trị là PFR 01, TEETH là 44 và INK COLOR là BLACK được sắp xếp cùng nhau sao cho cột FINAL D có ngày tăng dần cho đến khi hết TEETH có giá trị là 44 thì chuyển sang TEETH có giá trị 44, hết 44 thì chuyển sang 83, hết 83 thì chuyển sang 46 lần lượt như ảnh em gửi, nó phức tạp ở chỗ là nhiều dữ liệu quá ngồi làm thủ công thì rối loạn luôn.

2) nếu thứ tự ưu tiên được thay đổi thì khi bấm nút sắp xếp sẽ được thay đổi theo thứ tự ưu tiên mới
3) khi sắp xếp xong tiến hành tách sheet theo cột MACHINE NAME, ví dụ cột MACHINE NAME có 3 tên là PFR09, PFR01 và PFR04 thì tách thành 3 sheets, nghĩa là có bao nhiêu tên thì tách thành bây nhiêu sheet

1727684604007.png
 

File đính kèm

Lần chỉnh sửa cuối:
Giải pháp
Phuocam
HieuCD đã viết:
Đôi khi thớt sort theo 4 cột hoặc 6 cột thì phải làm sao? :)
Nhấp chuột vào đây để mở rộng...
Chỉnh lại một chút bạn hiền:
Mã: 
Sub SortbyMultipleColumns()
Dim lastRow As Long, i As Long, rng As Range, SortRng As Range
With Worksheets("PFL_PRINT")
    lastRow = .Range("B9").End(xlDown).Row
    Set rng = Range("B9:AT" & lastRow) '
    For i = 31 To 1 Step -1
        Set SortRng = .Range("A8:AC8").Find(i)
        If Not SortRng Is Nothing Then rng.Sort Key1:=SortRng.Offset(1, 0), Order1:=xlAscending
    Next
End With
End Sub
Đầy đủ thì thêm phần kiểm tra tên sheet và tách. Hahaha ...
Sắp xếp theo thời gian sắp xếp theo bầu chọn
thufpts đã viết:
em chào các bác!
em có một file excel có các cột ở dòng số 8 được đánh thứ tự ưu tiên và mong muốn được sắp xếp theo các điều kiện sau nhờ các bác, anh chị giúp đỡ
1) cột E, W, AC các dữ liệu giống nhau thì được sắp xếp cùng nhau theo thứ tự ưu tiên đã đánh đâu ở dòng số 8, cột G sắp xếp tăng dần
2) nếu thứ tự ưu tiên được thay đổi thì khi bấm nút sắp xếp sẽ được thay đổi theo thứ tự ưu tiên mới
3) khi sắp xếp xong tiến hành tách sheet theo cột MACHINE NAME, ví dụ cột MACHINE NAME có 3 tên là PFR09, PFR01 và PFR04 thì tách thành 3 sheets, nghĩa là có bao nhiêu tên thì tách thành bây nhiêu sheet
Nhấp chuột vào đây để mở rộng...
File còn cả mật khẩu thì theo bạn nên hỗ trợ thế nào?
 
Upvote 0
thufpts đã viết:
Đúng rồi nhưng chức năng sort của excel không làm được, có nhiều điều kiện như em đã nêu
Nhấp chuột vào đây để mở rộng...

thufpts đã viết:
em chào các bác!
em có một file excel có các cột ở dòng số 8 được đánh thứ tự ưu tiên và mong muốn được sắp xếp theo các điều kiện sau nhờ các bác, anh chị giúp đỡ
1) cột E, W, AC các dữ liệu giống nhau thì được sắp xếp cùng nhau theo thứ tự ưu tiên đã đánh đâu ở dòng số 8, cột G sắp xếp tăng dần
2) nếu thứ tự ưu tiên được thay đổi thì khi bấm nút sắp xếp sẽ được thay đổi theo thứ tự ưu tiên mới
3) khi sắp xếp xong tiến hành tách sheet theo cột MACHINE NAME, ví dụ cột MACHINE NAME có 3 tên là PFR09, PFR01 và PFR04 thì tách thành 3 sheets, nghĩa là có bao nhiêu tên thì tách thành bây nhiêu sheet


View attachment 304337
Nhấp chuột vào đây để mở rộng...
Viết code mẫu cho bạn nghiên cứu. Code chưa hoàn chỉnh vì vấn đề bạn đưa ra chưa hoàn chỉnh
Mã: 
Sub SapXepDuLieu()
Dim SortRng As Range, sh As Worksheet
Set sh = Sheets("PFL_PRINT")
Set SortRng = sh.Range("E9", sh.Range("E9").End(4))
With sh.Sort
   .SortFields.Clear
   .SetRange SortRng.Resize(, 25)
   .SortFields.Add SortRng.Offset(, 0)
   .SortFields.Add SortRng.Offset(, 24)
   .SortFields.Add SortRng.Offset(, 18)
   .SortFields.Add SortRng.Offset(, 2)
   .SortFields.Add SortRng.Offset(, 15)
   .Header = xlYes
   .Apply
   .SortFields.Clear
End With
End Sub
Sub Tach_Sheet()
Application.ScreenUpdating = False
Dim sArr(), i As Long, sMachine(), j As Long, k As Long, dArr(), n As Long
With Sheets("PFL_PRINT")
   sArr = .Range("E10", .Range("E9").End(4)).Resize(, 25).Value
End With
With CreateObject("scripting.dictionary")
   For i = 1 To UBound(sArr)
      If Not .Exists(sArr(i, 1)) Then .Add sArr(i, 1), ""
   Next
   sMachine = .keys
End With
For n = 0 To UBound(sMachine)
    ReDim dArr(1 To UBound(sArr), 1 To UBound(sArr, 2))
    k = 0
    For i = 1 To UBound(sArr)
        If sArr(i, 1) = sMachine(n) Then
            k = k + 1
            For j = 1 To UBound(sArr, 2)
                dArr(k, j) = sArr(i, j)
            Next
        End If
    Next
    With Sheets.Add
        .Name = sMachine(n)
        .Range("E10").Resize(k, UBound(dArr, 2)) = dArr
    End With
Next
Application.ScreenUpdating = True
End Sub
 
Upvote 0
BuiQuangThuan đã viết:
Bạn đang làm thủ công bằng cách nào?
Kết quả mẫu bạn muốn là như nào
Nhấp chuột vào đây để mở rộng...

Dạ em sẽ mổ tả kết quả mong muốn và tô màu để bác dễ nhận biết hơn
các cột dữ liệu có cùng giá trị MACHINE NAME, TEETH, INK COLOR được sắp xếp lên cùng nhau sao cho cột FINAL D có ngày được sắp xếp tăng dần và INK COLOR nếu có các màu khác thì ưu tiên màu BLACK trước
ví dụ kết quả như sau khi bấm nút "sap xep" sẽ sắp xếp MACHINE có 7 dòng giá trị là PFR 01, TEETH là 44 và INK COLOR là BLACK được sắp xếp cùng nhau sao cho cột FINAL D có ngày tăng dần cho đến khi hết TEETH có giá trị là 44 thì chuyển sang TEETH có giá trị 44, hết 44 thì chuyển sang 83, hết 83 thì chuyển sang 46 lần lượt như ảnh em gửi, nó phức tạp ở chỗ là nhiều dữ liệu quá ngồi làm thủ công thì rối loạn luôn.

1727667075248.png
Bài đã được tự động gộp:

Quang_Hải đã viết:
Viết code mẫu cho bạn nghiên cứu. Code chưa hoàn chỉnh vì vấn đề bạn đưa ra chưa hoàn chỉnh
Mã: 
Sub SapXepDuLieu()
Dim SortRng As Range, sh As Worksheet
Set sh = Sheets("PFL_PRINT")
Set SortRng = sh.Range("E9", sh.Range("E9").End(4))
With sh.Sort
   .SortFields.Clear
   .SetRange SortRng.Resize(, 25)
   .SortFields.Add SortRng.Offset(, 0)
   .SortFields.Add SortRng.Offset(, 24)
   .SortFields.Add SortRng.Offset(, 18)
   .SortFields.Add SortRng.Offset(, 2)
   .SortFields.Add SortRng.Offset(, 15)
   .Header = xlYes
   .Apply
   .SortFields.Clear
End With
End Sub
Sub Tach_Sheet()
Application.ScreenUpdating = False
Dim sArr(), i As Long, sMachine(), j As Long, k As Long, dArr(), n As Long
With Sheets("PFL_PRINT")
   sArr = .Range("E10", .Range("E9").End(4)).Resize(, 25).Value
End With
With CreateObject("scripting.dictionary")
   For i = 1 To UBound(sArr)
      If Not .Exists(sArr(i, 1)) Then .Add sArr(i, 1), ""
   Next
   sMachine = .keys
End With
For n = 0 To UBound(sMachine)
    ReDim dArr(1 To UBound(sArr), 1 To UBound(sArr, 2))
    k = 0
    For i = 1 To UBound(sArr)
        If sArr(i, 1) = sMachine(n) Then
            k = k + 1
            For j = 1 To UBound(sArr, 2)
                dArr(k, j) = sArr(i, j)
            Next
        End If
    Next
    With Sheets.Add
        .Name = sMachine(n)
        .Range("E10").Resize(k, UBound(dArr, 2)) = dArr
    End With
Next
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
dạ em cám ơn em đã chạy thử code này rồi, nó gần đúng ạ, em xin lỗi vì không mô tả rõ, code của bác còn thiếu phần sắp xếp cho crd tăng dần điều mà em đã mô tả thiếu xót, em đã viết thêm mô tả ở bài #8, bác xem giúp em
 
Upvote 0
thufpts đã viết:
Dạ em sẽ mổ tả kết quả mong muốn và tô màu để bác dễ nhận biết hơn
các cột dữ liệu có cùng giá trị MACHINE NAME, TEETH, INK COLOR được sắp xếp lên cùng nhau sao cho cột FINAL D có ngày được sắp xếp tăng dần và INK COLOR nếu có các màu khác thì ưu tiên màu BLACK trước
ví dụ kết quả như sau khi bấm nút "sap xep" sẽ sắp xếp MACHINE có 7 dòng giá trị là PFR 01, TEETH là 44 và INK COLOR là BLACK được sắp xếp cùng nhau sao cho cột FINAL D có ngày tăng dần cho đến khi hết TEETH có giá trị là 44 thì chuyển sang TEETH có giá trị 44, hết 44 thì chuyển sang 83, hết 83 thì chuyển sang 46 lần lượt như ảnh em gửi, nó phức tạp ở chỗ là nhiều dữ liệu quá ngồi làm thủ công thì rối loạn luôn.

View attachment 304351
Bài đã được tự động gộp:


dạ em cám ơn em đã chạy thử code này rồi, nó gần đúng ạ, em xin lỗi vì không mô tả rõ, code của bác còn thiếu phần sắp xếp cho crd tăng dần điều mà em đã mô tả thiếu xót, em đã viết thêm mô tả ở bài #8, bác xem giúp em
Nhấp chuột vào đây để mở rộng...
Nếu như không tính CRD thì code đúng ý chưa?
 
Upvote 0
Tách sheet bác code giúp em xoá sheet đã tồn tại trước sau đó tách sau, số cột cần lấy là từ A đến AF lấy cả cột tiêu đề dòng số 9 cho các sheet đã tách
Bài đã được tự động gộp:

Quang_Hải đã viết:
Thử luôn code tách sheet chưa?
Nhấp chuột vào đây để mở rộng...
Tách sheet bác code giúp em xoá sheet đã tồn tại trước sau đó tách sau, số cột cần lấy là từ A đến AF lấy cả cột tiêu đề dòng số 9 cho các sheet đã tách
 
Upvote 0
Code sort 5 tiêu chí (tiêu chí động) gọn nhẹ thế này. Nếu thêm cột CRD thì phải sửa 1 chút code nhưng phải đánh số cho F8 (số mấy tôi không biết nên không làm)
Mã: 
Sub SortbyColumnNum()
Dim lastRw As Long, SortArr(1 To 5)
With Worksheets("PFL_PRINT")
    For i = 1 To 5
        Set SortArr(i) = .[E8:AC8].Find(i).Offset(1, 0)
    Next
    lastRw = .[E50000].End(xlUp).Row
    .Range("E9:AC" & lastRw).Sort _
    Key1:=SortArr(1), Order1:=xlAscending, _
    Key2:=SortArr(2), Order2:=xlAscending, _
    Key3:=SortArr(3), Order3:=xlAscending, _
    Key1:=SortArr(4), Order1:=xlAscending, _
    Key2:=SortArr(5), Order2:=xlAscending
End With
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
ptm0412 đã viết:
Code sort 5 tiêu chí (tiêu chí động) gọn nhẹ thế này. Nếu thêm cột CRD thì phải sửa 1 chút code nhưng phải đánh số cho F8 (số mấy tôi không biết nên không làm)
Mã: 
Sub SortbyColumnNum()
Dim lastRw As Long, SortArr(1 To 5)
With Worksheets("PFL_PRINT")
    For i = 1 To 5
        Set SortArr(i) = .[E8:AC8].Find(i).Offset(1, 0)
    Next
    lastRw = .[E50000].End(xlUp).Row
    .Range("E9:AC" & lastRw).Sort _
    Key1:=SortArr(1), Order1:=xlAscending, _
    Key2:=SortArr(2), Order2:=xlAscending, _
    Key3:=SortArr(3), Order3:=xlAscending, _
    Key1:=SortArr(4), Order1:=xlAscending, _
    Key2:=SortArr(5), Order2:=xlAscending
End With
End Sub
Nhấp chuột vào đây để mở rộng...
bác có thể xem em mô tả chi tiết ở bài 8 để code được không, em chạy code này rồi nhưng nó không hiển thỉ đúng, nó không đơn giản là đánh số ưu tiên cho F8 nếu đánh số thì sau chức năng sort của excel có thể giải quyết được, nhưng hi vọng bác nhìn lại giúp em bài số 8, ở đây là gom lại và sắp xếp cả cái cụm đó theo FINAL D tăng dần
 
Lần chỉnh sửa cuối:
Upvote 0
thufpts đã viết:
bác có thể xem em mô tả chi tiết ở bài 8 để code được không,
Nhấp chuột vào đây để mở rộng...
Không. Tôi làm theo bài 1, và làm theo ưu tiên sắp xếp đã đánh số ở dòng 8. Bạn mô tả thế nào thì tôi làm thế ấy rồi.
Bài 8 mô tả sai: Hết 44 thì tới 46, tới 48, tới 56 chứ tại sao nhảy vọt lên 83 rồi về lại 46? Vậy các con số dòng 8 có ý nghĩa quái gì nữa!
 
Upvote 0
thufpts đã viết:
Nếu như chưa tính cột FINAL D thì như vậy là đúng rồi ạ. giờ thêm điều kiện cột FINAL thì nó sẽ hiển thị giống như những gì em mô tả.
Nhấp chuột vào đây để mở rộng...
Thử lại đoạn code này nhé. Mình có ghi chú cho từng dòng code. Không cần chỗ nào thì xóa dòng code đấy nhé
Mã: 
Sub SapXepDuLieu()
Dim SortRng As Range, sh As Worksheet
Set sh = Sheets("PFL_PRINT")
Set SortRng = sh.Range("E9", sh.Range("E9").End(4))
With sh.Sort
   .SortFields.Clear
   .SetRange SortRng.Resize(, 25)
   .SortFields.Add SortRng.Offset(, 0) 'Cot Machine
   .SortFields.Add SortRng.Offset(, 24) 'Cot Ink Color
   .SortFields.Add SortRng.Offset(, 18) 'Cot Teeth
   .SortFields.Add SortRng.Offset(, 2) 'Cot CRD
   .SortFields.Add SortRng.Offset(, 3) 'Cot Final D
   .SortFields.Add SortRng.Offset(, 15) 'Cot Total Hour
   .Header = xlYes
   .Apply
   .SortFields.Clear
End With
End Sub
 
Upvote 0
Quang_Hải đã viết:
Thử lại đoạn code này nhé. Mình có ghi chú cho từng dòng code. Không cần chỗ nào thì xóa dòng code đấy nhé
Nhấp chuột vào đây để mở rộng...
Mô tả như bài 1 thì khi đánh số lại ở dòng 8 code sẽ sắp xếp theo ưu tiên mới của dòng 8
Mô tả như bài 8 thì dù ưu tiên kiểu gì cũng ra kết quả không giống hình bài 8.
Thế nên code mới này của Hải cũng không đáp ứng.
 
Upvote 0
ptm0412 đã viết:
Không. Tôi làm theo bài 1, và làm theo ưu tiên sắp xếp đã đánh số ở dòng 8. Bạn mô tả thế nào thì tôi làm thế ấy rồi.
Bài 8 mô tả sai: Hết 44 thì tới 46, tới 48, tới 56 chứ tại sao nhảy vọt lên 83 rồi về lại 46? Vậy các con số dòng 8 có ý nghĩa quái gì nữa!
Nhấp chuột vào đây để mở rộng...
Vâng là thiếu sót của em, em đã chỉnh lại yêu cầu của bài 1 rồi. mong bác xem xét.
Bài đã được tự động gộp:

Quang_Hải đã viết:
Thử lại đoạn code này nhé. Mình có ghi chú cho từng dòng code. Không cần chỗ nào thì xóa dòng code đấy nhé
Mã: 
Sub SapXepDuLieu()
Dim SortRng As Range, sh As Worksheet
Set sh = Sheets("PFL_PRINT")
Set SortRng = sh.Range("E9", sh.Range("E9").End(4))
With sh.Sort
   .SortFields.Clear
   .SetRange SortRng.Resize(, 25)
   .SortFields.Add SortRng.Offset(, 0) 'Cot Machine
   .SortFields.Add SortRng.Offset(, 24) 'Cot Ink Color
   .SortFields.Add SortRng.Offset(, 18) 'Cot Teeth
   .SortFields.Add SortRng.Offset(, 2) 'Cot CRD
   .SortFields.Add SortRng.Offset(, 3) 'Cot Final D
   .SortFields.Add SortRng.Offset(, 15) 'Cot Total Hour
   .Header = xlYes
   .Apply
   .SortFields.Clear
End With
End Sub
Nhấp chuột vào đây để mở rộng...
bác xem lại giúp em vì các cột còn lại nằm ngoài vùng nó không di chuyển theo di bấm nút sắp xếp, em mới kiểm tra được cột B, C, D nó không di chuyển được theo.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
thufpts đã viết:
Vâng là thiếu sót của em, em đã chỉnh lại yêu cầu của bài 1 rồi. mong bác xem xét.
Bài đã được tự động gộp:


bác xem lại giúp em vì các cột còn lại nằm ngoài vùng nó không di chuyển theo di bấm nút sắp xếp, em mới kiểm tra được cột B, C, D nó không di chuyển được theo.
Nhấp chuột vào đây để mở rộng...
Tiếc quá, năng lực của mìn chỉ có bấy nhiêu thôi.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

N
Một ví dụ về XLL add-in: Tương tác với Google Gemini dưới dạng công thức bảng tính (2 người xem)
Trả lời
0
Đọc
26
nguyendang95
N
H
Nhờ anh/chị giúp đỡ em viết công thức trừ dữ liệu theo FiFo (1 người xem)
Trả lời
1
Đọc
61
HieuCD
H
BNTT
LockXLS - Chương trình bảo vệ an toàn cho các file bảng tính Excel (11 người xem)
    • Thích
4 5 6
Trả lời
118
Đọc
73K
YêuCN
Y
vsitcnh
Hỗ trợ công thức tính điểm dựa theo điều kiện. (1 người xem)
Trả lời
14
Đọc
160
thuytrangbp28
T
F
  • Question Question
Tự động Merge Mail bằng VBA (1 người xem)
Trả lời
4
Đọc
149
Hoàng Tuấn 868
H
K
  • Question Question
nhờ ace giúp đỡ tự động filter và In hàng loạt từng mục trong piviot table
Trả lời
0
Đọc
59
khkkh
K
micam111
  • Question Question
Cách chạy nhiều đồng hồ đếm giờ trong VBA
Trả lời
4
Đọc
672
thuytrangbp28
T
B
Xin giải pháp chống sửa, xóa dữ liệu đã nhập vào từ ngày hôm trước.
    • Thích
2
Trả lời
26
Đọc
7K
Tuấn Bụng Bự
Tuấn Bụng Bự
Emyeuexcel
  • Question Question
In tất cả các file trong cùng 1 thư mục
Trả lời
3
Đọc
193
Hoàng Tuấn 868
H
L
Lỗi font khi convert từ pdf
Trả lời
2
Đọc
92
DeTong
D
1
Hỏi về đánh dấu hàng ngang hàng dọc bằng màu khi kích chuột vào 1 ô
Trả lời
7
Đọc
188
Gà Công Nghệ
Gà Công Nghệ
PhanTuHuong
Sách Lập trình VBA trong AutoCAD đã có mặt
    • Thích
    • Yêu thích
2
Trả lời
20
Đọc
1K
Mr.hieudoanxd
Mr.hieudoanxd
P
Excell code vba : Tìm Cell để sửa dữ liệu
    • Buồn
2
Trả lời
26
Đọc
554
Phạm Trường 80
P
D
Nhờ anh em giúp đỡ.
    • Buồn
Trả lời
2
Đọc
87
SA_DQ
SA_DQ
00029591
Cần hỗ trợ công thức tổng hợp dữ liệu không cần cột phụ Vlookup (1 người xem)
Trả lời
2
Đọc
92
DeTong
D
H
Đổi số thành chữ trong office 365
Trả lời
19
Đọc
1K
HoangTan891026
H
Gà Công Nghệ
Lấy dữ liệu file excel từ sheet này sang sheet khác
Trả lời
4
Đọc
136
Gà Công Nghệ
Gà Công Nghệ
N
Mong mọi người giúp đỡ
Trả lời
1
Đọc
65
minhminh27
minhminh27
minhduc1o2
Excel lỗi font Time New Roman+
Trả lời
7
Đọc
117
minhduc1o2
minhduc1o2
H
Lọc dữ liệu trong XL
    • Cười
Trả lời
0
Đọc
52
huong.dinh
H
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALK SHOW: CÙNG NHẢY LAM BA ĐA VỚI HÀM LAMBDA (λ) EXCEL 365
Back
Top Bottom