Viết code sắp xếp dữ liệu ô có Merge Cells (1 người xem)

  • Thread starter Thread starter mhieuit
  • Ngày gửi Ngày gửi
Elx 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)
mhieuit

mhieuit

Thành viên hoạt động
Tham gia
3/9/13
Bài viết
163
Được thích
19
Nghề nghiệp
Data controller
Dear GPE,
em có file att, anh chi GPE giup em sort tăng dần theo cot Desc Chi tiết (viet code giup em nhe)

note: cột này đã trộn ô rồi

thanks GPE rât nhiều
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
[note]
1. Tiêu đề phạm quy vì không giấu, đặt tên cũng chung chung
2. Bạn cần giúp viết code lại đưa bài vào Box Nhưng vấn đề chung -> Sai Box
Lưu ý lần sau nhé bạn. Tôi sẽ di chuyển đề tài vào box hợp lý
Cảm ơn bạn.
[/note]

VBA tối kỵ với việc merge cells, code sort bình thường không áp dụng được trong trường hợp này.
 
Lần chỉnh sửa cuối:
Upvote 0
Thì bạn chép nội dung cột trộn đó đem gởi tạm vô cột 'Ghi chú' ở fía sau & xếp sắp theo cột trung gian này
Sau đó xóa dữ liệu trung gian đi.

Các bước này bạn thử tự ghi bằng bộ thu macro cũa VBA xem sao
 
Upvote 0
HYen17 đã viết:
Thì bạn chép nội dung cột trộn đó đem gởi tạm vô cột 'Ghi chú' ở fía sau & xếp sắp theo cột trung gian này
Sau đó xóa dữ liệu trung gian đi.

Các bước này bạn thử tự ghi bằng bộ thu macro cũa VBA xem sao
Nhấp chuột vào đây để mở rộng...
Hi HYen17,
file att chỉ 1 trong những sheet demo, vì file của em có thể có rất nhiều sheet, vi em load từ hệ thống về thì đã merge cell sẳn rồi. HYen17 còn có cách nào khả thi hơn không.
 
Lần chỉnh sửa cuối:
Upvote 0
Cá ngừ F1 đã viết:
[note]
1. Tiêu đề phạm quy vì không giấu, đặt tên cũng chung chung
2. Bạn cần giúp viết code lại đưa bài vào Box Nhưng vấn đề chung -> Sai Box
Lưu ý lần sau nhé bạn. Tôi sẽ di chuyển đề tài vào box hợp lý
Cảm ơn bạn.
[/note]

VBA tối kỵ với việc merge cells, code sort bình thường không áp dụng được trong trường hợp này.
Nhấp chuột vào đây để mở rộng...
Hi Anh,
vậy là không có cách nào để khắc phục tình huống này sao anh?
 
Upvote 0
File att chỉ 1 trong những sheet demo, vì file của em có thể có rất nhiều sheet, vi em load từ hệ thống về thì đã merge cell sẳn rồi. HYen17 còn có cách nào khả thi hơn không.
Nhấp chuột vào đây để mở rộng...

Bao nhiêu Sheet cũng được, miễn là cấu trúc, tên gọi,. . . của chúng có thể tự động hóa bằng macro được là OK tất!

2uan trọng là bạn có trong tay con macro thân thương để chạy cho các trang tính cùng cấu trúc í mà thôi.
 
Upvote 0
Trong công việc nếu cần như vậy, thì tại sao ta không nghĩ đến việc bỏ Merge đi và xoá cột rổng rồi sort nhỉ.
 
Upvote 0
be09 đã viết:
Trong công việc nếu cần như vậy, thì tại sao ta không nghĩ đến việc bỏ Merge đi và xoá cột rổng rồi sort nhỉ.
Nhấp chuột vào đây để mở rộng...

Hi anh,
như em đã có nói, file này em load từ hệ thống về đã merge sẳn rồi, nên không thể bỏ được a!
 
Upvote 0
ChanhTQ@ đã viết:
Bao nhiêu Sheet cũng được, miễn là cấu trúc, tên gọi,. . . của chúng có thể tự động hóa bằng macro được là OK tất!

2uan trọng là bạn có trong tay con macro thân thương để chạy cho các trang tính cùng cấu trúc í mà thôi.
Nhấp chuột vào đây để mở rộng...
Hi anh,
Ý kiến của anh em xin được tiếp thu ạ, em sẽ chú ý hơn mỗi khi tạo và chạy một macro thân thương !
 
Upvote 0

File đính kèm

Upvote 0
mhieuit đã viết:
Hi anh,
em gửi file att, bên trong file em có nội dung em cần anh code giúp, check giúp em nhe. Thanks anh.
Nhấp chuột vào đây để mở rộng...

bạn không cần phải bỏ merged đâu, để nguyên code cho thích

Để con trỏ ở sheet cần sắp xếp bấm Ctr+r là run sắp xếp

Alt+F11 để xem code
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
giola đã viết:
bạn không cần phải bỏ merged đâu, để nguyên code cho thích

Để con trỏ ở sheet cần sắp xếp bấm Ctr+r là run sắp xếp

Alt+F11 để xem code
Nhấp chuột vào đây để mở rộng...

Hi anh,
em đã test code của anh, nhưng kết quả như hình att, anh check lại giúp em với. Thanks anh
 

File đính kèm

  • Capture.jpg
    Capture.jpg
    43.9 KB · Đọc: 18
  • Capture_1.jpg
    Capture_1.jpg
    43.7 KB · Đọc: 14
Upvote 0
giola đã viết:
Thế là kết quả chính xác đúng không bạn, vì bạn muốn sắp xếp cột "Desc Chi tiết" nên kết quả là đúng ???
Nhấp chuột vào đây để mở rộng...
Hi anh,
Kết quả sort cột Desc Chi tiết là chính xác rồi ạ, Nhưng line 12 của cột code 4 =0 kìa anh.
 
Upvote 0
Thi code của cột đó đúng =0 nên là 0, bạn định dạng format cho cột đó dạng 4 số 0000 thì sẽ trở lại đúng thôi
 
Upvote 0

File đính kèm

Upvote 0
bạn Bấm ctrl+a rồi bấm ctrl+c để copy toàn bộ code của module sang module của file mới, nhớ rằng vị trí dữ liệu sắp xếp phải giống nhau nhé
 
Upvote 0
giola đã viết:
bạn Bấm ctrl+a rồi bấm ctrl+c để copy toàn bộ code của module sang module của file mới, nhớ rằng vị trí dữ liệu sắp xếp phải giống nhau nhé
Nhấp chuột vào đây để mở rộng...
Hi anh,
em có 1 file att, có nhiều sheet, anh code dùm em cho lần lượt setup qua các sheet còn không, nếu bấm từng sheet thì không khả thi lắm. Thanks anh
 

File đính kèm

Upvote 0
** lưu ý tất cả các sheet đều là PGH

+copy toàn module sang,

+ và thay toàn bộ sortPGH thành cái sau

PHP: 
'__________ code by giola, 01.2015
Sub sortPGH()

    Const VungSort = "B15:W15"  'vung dong tieu de dau tien
    Const colSort = 6           'thu tu cot sap xep
    Const sort_AtoZ = True      'sap xep theo AtoZ (True), neu False la ZtoA
    
    Dim Rg As Range
    Dim ceL As Range
    Dim Sh As Worksheet
    Dim a As Variant
    Dim b As Variant
    
    Dim wB As Workbook
    Set wB = ActiveWorkbook
        
    If MsgBox("ban co chac chan sap xep vung du lieu " & VungSort & "  cho tat ca cac Sheets trong files(Y/N)?", _
                    vbYesNo + vbQuestion) <> vbYes Then GoTo end_
    On Error Resume Next
    For Each Sh In wB.Sheets
        Set Rg = Sh.Range(VungSort)
        Set Rg = Rg.Offset(1).Resize(Sh.[B65536].End(xlUp).Row - Rg.Row)
        
        '''If MsgBox("ban co chac chan sap xep vung du lieu " & Rg.Address & " (Y/N)?", _
                    vbYesNo + vbQuestion) <> vbYes Then GoTo end_
        a = Rg.Value
       b = QuickSort2DArray(Arr:=a, _
                             col_sort:=colSort, _
                             sortAtoZ:=sort_AtoZ)
        Rg = b
    Next
    MsgBox "Ket thuc, Da sap xep xong"
end_:
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
giola đã viết:
** lưu ý tất cả các sheet đều là PGH

+copy toàn module sang,

+ và thay toàn bộ sortPGH thành cái sau

PHP: 
'__________ code by giola, 01.2015
Sub sortPGH()

    Const VungSort = "B15:W15"  'vung dong tieu de dau tien
    Const colSort = 6           'thu tu cot sap xep
    Const sort_AtoZ = True      'sap xep theo AtoZ (True), neu False la ZtoA
    
    Dim Rg As Range
    Dim ceL As Range
    Dim Sh As Worksheet
    Dim a As Variant
    Dim b As Variant
    
    Dim wB As Workbook
    Set wB = ActiveWorkbook
        
    If MsgBox("ban co chac chan sap xep vung du lieu " & VungSort & "  cho tat ca cac Sheets trong files(Y/N)?", _
                    vbYesNo + vbQuestion) <> vbYes Then GoTo end_
    On Error Resume Next
    For Each Sh In wB.Sheets
        Set Rg = Sh.Range(VungSort)
        Set Rg = Rg.Offset(1).Resize(Sh.[B65536].End(xlUp).Row - Rg.Row)
        
        '''If MsgBox("ban co chac chan sap xep vung du lieu " & Rg.Address & " (Y/N)?", _
                    vbYesNo + vbQuestion) <> vbYes Then GoTo end_
        a = Rg.Value
        b = QuickSort2DArray(Arr:=a, _
                             col_sort:=colSort, _
                             sortAtoZ:=sort_AtoZ)
        Rg = b
    Next
    MsgBox "Ket thuc, Da sap xep xong"
end_:
End Sub
Nhấp chuột vào đây để mở rộng...
HI anh,
em đang test code của anh vào file chính thức bên em, em dự đinh addin để sử dụng, nếu có kết quả em sẽ back lại sau anh nhé.

cám ơn anh rất nhiều.
 
Upvote 0
mhieuit đã viết:
HI anh,
em đang test code của anh vào file chính thức bên em, em dự đinh addin để sử dụng, nếu có kết quả em sẽ back lại sau anh nhé.

cám ơn anh rất nhiều.
Nhấp chuột vào đây để mở rộng...

Uhm, cho toàn bộ code vào file trắng, rồi đặt phím tắt cho macro sortPGH() save thành dạng addins, là dùng thoả mãi: tại file gồm toàn các sheetPGH thì bấm phím tắt đã đặt là chạy tốt
 
Upvote 0
giola đã viết:
bạn không cần phải bỏ merged đâu, để nguyên code cho thích

Để con trỏ ở sheet cần sắp xếp bấm Ctr+r là run sắp xếp

Alt+F11 để xem code
Nhấp chuột vào đây để mở rộng...
Hi anh,
file att a thay đổi rồi ak, em thấy code mất hết phần moudle bên dưới, cho em xin code lại nhé, thanks anh
 
Upvote 0
Dear GPE,
em cần giúp các anh chi code tiếp giúp em vấn đề như sau:
file att là e nhờ anh giola code sắp xếp theo côt Desc đã ok, anh chi code tiếp code này sau khi sắp xếp theo côt Desc nếu trùng tên thì sắp xếp côt mã hàng tăng dần giúp em với.
Thanks GPE nhiều.
 
Lần chỉnh sửa cuối:
Upvote 0
mhieuit đã viết:
Dear GPE,
em cần giúp các anh chi code tiếp giúp em vấn đề như sau:
file att là e nhờ anh giola code sắp xếp theo côt Desc đã ok, anh chi code tiếp code này sau khi sắp xếp theo côt Desc nếu trùng tên thì sắp xếp côt mã hàng tăng dần giúp em với.
Thanks GPE nhiều.
Nhấp chuột vào đây để mở rộng...

Vấn đề của bạn, là đưa thêm yêu cầu không đưa ngay từ đầu, nên làm cho mọi người giúp đỡ khó khăn lại phải sửa đi sửa lại.

Tốt nhất là bạn mở chủ để mới với file mới hoàn toàn không lẫn cái cũ và đặt lại vấn đề, thì chắc có người giúp được
 
Upvote 0
giola đã viết:
Vấn đề của bạn, là đưa thêm yêu cầu không đưa ngay từ đầu, nên làm cho mọi người giúp đỡ khó khăn lại phải sửa đi sửa lại.

Tốt nhất là bạn mở chủ để mới với file mới hoàn toàn không lẫn cái cũ và đặt lại vấn đề, thì chắc có người giúp được
Nhấp chuột vào đây để mở rộng...
Hi anh,
mọi người có thể code lại hoặc code thêm giúp em mà. Mong mọi người code giúp em vấn đề này. Thanks all
 
Upvote 0
mhieuit đã viết:
Dear GPE,
em cần giúp các anh chi code tiếp giúp em vấn đề như sau:
file att là e nhờ anh giola code sắp xếp theo côt Desc đã ok, anh chi code tiếp code này sau khi sắp xếp theo côt Desc nếu trùng tên thì sắp xếp côt mã hàng tăng dần giúp em với.
Thanks GPE nhiều.
Nhấp chuột vào đây để mở rộng...
Mình code dựa theo file của bài 21 nha.
Bạn copy code này vào 1 module của file trong bài 21
Chạy thử Sub Main. Lạy trời cho trúng.
PHP: 
Sub Main()
Rem Written by QuangHai
Dim Data(), Temp As String, sh As Worksheet
Dim FirsrtRow As Long, FirstCol As String, SortOrder()
Dim TotalCols As Byte, Row As Long, J As Long
SortOrder = Array(7, 3)
For Each sh In Worksheets
   Data = sh.Range("A16", sh.[A65536].End(3)).Resize(, 24).Value
   TotalCols = UBound(Data, 2)
   ReDim Preserve Data(1 To UBound(Data), 1 To (TotalCols + 1))
   For Row = 1 To UBound(Data, 1)
      For J = 0 To UBound(SortOrder)
         Temp = Temp & Space(2) & Format(Data(Row, SortOrder(J)), String(10, "0"))
      Next
      Data(Row, TotalCols + 1) = Temp
      Temp = Empty
   Next
   QuickSort Data, LBound(Data), UBound(Data)
   sh.[A16].Resize(UBound(Data), TotalCols) = Data
Next
End Sub
Sub QuickSort(Arr(), Min As Long, Max As Long)
  Dim MidVal As Variant, TempVal As Variant
  Dim TempMin&, TempMax&, LastCol&, TotalCol&
  TempMin = Min
  TempMax = Max
  LastCol = UBound(Arr, 2)
  MidVal = Arr((Min + Max) \ 2, LastCol)
  Do While TempMin <= TempMax
    Do While Arr(TempMin, LastCol) < MidVal And TempMin < Max
      TempMin = TempMin + 1
    Loop
    Do While MidVal < Arr(TempMax, LastCol) And TempMax > Min
      TempMax = TempMax - 1
    Loop
    If TempMin <= TempMax Then
      For TotalCol = 1 To LastCol
         TempVal = Arr(TempMin, TotalCol)
         Arr(TempMin, TotalCol) = Arr(TempMax, TotalCol)
         Arr(TempMax, TotalCol) = TempVal
      Next
      TempMin = TempMin + 1
      TempMax = TempMax - 1
    End If
  Loop
  If Min < TempMax Then QuickSort Arr, Min, TempMax
  If TempMin < Max Then QuickSort Arr, TempMin, Max
End Sub
 
Upvote 0
quanghai1969 đã viết:
Mình code dựa theo file của bài 21 nha.
Bạn copy code này vào 1 module của file trong bài 21
Chạy thử Sub Main. Lạy trời cho trúng.
PHP: 
Sub Main()
Rem Written by QuangHai
Dim Data(), Temp As String, sh As Worksheet
Dim FirsrtRow As Long, FirstCol As String, SortOrder()
Dim TotalCols As Byte, Row As Long, J As Long
SortOrder = Array(7, 3)
For Each sh In Worksheets
   Data = sh.Range("A16", sh.[A65536].End(3)).Resize(, 24).Value
   TotalCols = UBound(Data, 2)
   ReDim Preserve Data(1 To UBound(Data), 1 To (TotalCols + 1))
   For Row = 1 To UBound(Data, 1)
      For J = 0 To UBound(SortOrder)
         Temp = Temp & Space(2) & Format(Data(Row, SortOrder(J)), String(10, "0"))
      Next
      Data(Row, TotalCols + 1) = Temp
      Temp = Empty
   Next
   QuickSort Data, LBound(Data), UBound(Data)
   sh.[A16].Resize(UBound(Data), TotalCols) = Data
Next
End Sub
Sub QuickSort(Arr(), Min As Long, Max As Long)
  Dim MidVal As Variant, TempVal As Variant
  Dim TempMin&, TempMax&, LastCol&, TotalCol&
  TempMin = Min
  TempMax = Max
  LastCol = UBound(Arr, 2)
  MidVal = Arr((Min + Max) \ 2, LastCol)
  Do While TempMin <= TempMax
    Do While Arr(TempMin, LastCol) < MidVal And TempMin < Max
      TempMin = TempMin + 1
    Loop
    Do While MidVal < Arr(TempMax, LastCol) And TempMax > Min
      TempMax = TempMax - 1
    Loop
    If TempMin <= TempMax Then
      For TotalCol = 1 To LastCol
         TempVal = Arr(TempMin, TotalCol)
         Arr(TempMin, TotalCol) = Arr(TempMax, TotalCol)
         Arr(TempMax, TotalCol) = TempVal
      Next
      TempMin = TempMin + 1
      TempMax = TempMax - 1
    End If
  Loop
  If Min < TempMax Then QuickSort Arr, Min, TempMax
  If TempMin < Max Then QuickSort Arr, TempMin, Max
End Sub
Nhấp chuột vào đây để mở rộng...

Capture.jpg
dear anh,
em có chạy thử code của anh, vài trường hợp thì code sort ok, vài trường hợp sort chưa đúng, anh xem ảnh att, anh code lại giúp em với nhé. Thanks anh
 
Upvote 0
Upvote 0
quanghai1969 đã viết:
Mình code nhầm rồi, mà hình như mình hết thuốc trị bài này rồi.
Nhấp chuột vào đây để mở rộng...
Dear anh,
em thử thay đổi code như bên dưới, code chạy ok rồi anh
SortOrder = Array(7, 6)--thay số 3 thành số 6, tương ứng với cột mã hàng
Capture.GIF
nhưng còn 1 vướng mắc đó là số thứ tự cũng chạy theo khi sort, anh có cách nào để khi sort stt không theo không anh. thank anh
 
Upvote 0
mhieuit đã viết:
Dear anh,
em thử thay đổi code như bên dưới, code chạy ok rồi anh
SortOrder = Array(7, 6)--thay số 3 thành số 6, tương ứng với cột mã hàng
View attachment 136469
nhưng còn 1 vướng mắc đó là số thứ tự cũng chạy theo khi sort, anh có cách nào để khi sort stt không theo không anh. thank anh
Nhấp chuột vào đây để mở rộng...

Mình đoán là bạn sẽ tự nhìn ra chỗ cần thay đổi. Đúng là phải thay số 3 thành số 6
......
Thay thử chỗ này Data = sh.Range("A16", sh.[A65536].End(3)).Resize(, 24).Value
Thành thế này Data = sh.Range("B16", sh.[B65536].End(3)).Resize(, 23).Value
.................
Và thêm chỗ này sh.[B16].Resize(UBound(Data), TotalCols) = Data
 
Upvote 0
quanghai1969 đã viết:
Mình đoán là bạn sẽ tự nhìn ra chỗ cần thay đổi. Đúng là phải thay số 3 thành số 6
......
Thay thử chỗ này Data = sh.Range("A16", sh.[A65536].End(3)).Resize(, 24).Value
Thành thế này Data = sh.Range("B16", sh.[B65536].End(3)).Resize(, 23).Value
.................
Và thêm chỗ này sh.[B16].Resize(UBound(Data), TotalCols) = Data
Nhấp chuột vào đây để mở rộng...

Dear anh
Code chạy ok rồi anh ơi, em sẽ cho áp dụng thực tế, nếu trong quá trình sử dụng có gì sai em sẽ back lại sau nhe.
chân thành cám ơn anh rất nhiều.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

L
Tính thời gian làm việc thực tế
Trả lời
66
Đọc
14K
YenTon
Y
H
Chia sẻ file in Phiếu điều tra PCGD
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
13
Đọc
627
Phuong7686
P
GPE-Trợ Lý
  • Dán lên cao
[KHẨN] HƯỚNG VỀ ĐỒNG BÀO CHỊU ẢNH HƯỞNG CỦA BÃO YAGI - BẢO YÊN, LÀO CAI (1 người xem)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
91
Đọc
14K
SA_DQ
SA_DQ
SA_DQ
Copilot bình luận về một ván cờ vua
    • Thích
Trả lời
6
Đọc
409
SA_DQ
SA_DQ
92nguyenthanh
  • Question Question
Vba cho file nhập xuất kho (1 người xem)
Trả lời
4
Đọc
107
HUONGHCKT
H
C
Fix lỗi Application.InputBox Type:=8
    • Cười
Trả lời
25
Đọc
618
ptm0412
ptm0412
GPE-Trợ Lý
[GPE] TALK SHOW 08: GIẢI QUYẾT VẤN ĐỀ TỐI ƯU HÓA TRONG EXCEL VỚI CÔNG CỤ SOLVER
    • Thích
    • Cảm ơn
Trả lời
4
Đọc
3K
DuongLeHung
D
Gà Công Nghệ
Chế độ chính sách cho giáo viên mầm non giữ trẻ khuyết tật
Trả lời
1
Đọc
57
vanle33
vanle33
huuthang_bd
Add-in DeleteVirusMacro - Xóa và ngăn chặn virus macro
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
56
Đọc
22K
dunghtgiga
dunghtgiga
L
  • Question Question
Viết code tìm kiếm các file trong Folder (1 người xem)
Trả lời
40
Đọc
12K
lan nguyen0987
L
P
Hyperlink_Cách chuyển cả thư mục và file tổng hợp sang máy khác không bị lỗi
Trả lời
5
Đọc
108
phongvanvu
P
HeSanbi
Tiện ích Web: Tự động nhấn nút "Bỏ qua" quảng cáo Youtube
    • Thích
    • Yêu thích
Trả lời
14
Đọc
1K
ongke0711
ongke0711
ptm0412
Quá tin tưởng vào AI các thể loại
    • Cười
Trả lời
4
Đọc
218
Maika8008
Maika8008
A
  • Question Question
Không tìm được lỗi code
Trả lời
6
Đọc
159
ptm0412
ptm0412
W
Tham chiếu theo chuỗi ký tự
Trả lời
8
Đọc
314
dungpham01
D
tritv.dad
Lấy dữ liệu từ folder các tờ khai thông quan để theo dõi hiệu suất công việc. (1 người xem)
Trả lời
8
Đọc
285
BlueSphere
B
GPE-Trợ Lý
MỪNG NGÀY NHÀ GIÁO VIỆT NAM 20/11 (1 người xem)
    • Thích
Trả lời
0
Đọc
2K
GPE-Trợ Lý
GPE-Trợ Lý
SA_DQ
Xin chúc mừng các thầy cô giáo trên cộng đồng nhân 20/11
    • Thích
    • Yêu thích
Trả lời
1
Đọc
135
BuiQuangThuan
B
M
chuyển đổi số thành chữ
Trả lời
15
Đọc
371
dungpham01
D
V
Lỗi copy sheet: the name already exists.
Trả lời
7
Đọc
702
nghiabros
N
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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom