thêm code sắp xếp từ nhỏ lênh cao (1 người xem)

[titanic]

chào các anh/chị

file excel em gửi đính kèm nó có chức năng phân loại theo từng kiểu. nhưng em cần thêm chức năng sắp sếp theo giá bán (tăng dần từ A=>z) khi mình bấm vào nút "LỌC"
nhờ anh chị giúp dùm em. cảm ơn

 

[titanic]

nhà mình có ai rảnh. tải file dính kèm về giúp dùm em với ạ ? em cảm ơn

 

[titanic]

xin lỗi các bác em đã quá lời ạ

 

[doveandrose]

em biết trên diễn đàn có nhiều người giỏ lám nhưng không hiểu sao không ai chiệu giúp dùm em nhỉ ? anh nào giúp dùm em xin hậu tạ một cái thể cào điện thoại 100k được không ạ. xem như chút lòng cảm ơn ạ.

ối kèo thơm kìa các vị anh hùng . Diễn đàn mình có thợ săn tiền thưởng không nhỉ ? vào giao lưu kìa .

 

[titanic]

dạ em biết trên diễn đàn mình không có kinh doanh . chủ yếu là trao đổi và học hỏi kinh nghiệm. nhưng tại em kiến thức có hạn. nên mới nhờ các bác giúp dùm em nhưng lâu không thấy ai quan tâm nên nhắn tin vậy chứ không có ý mua bán gì đâu ạ. Thất lòng em cũng muốn đóng góp chút gì cho ai đó cỏ thể giúp em qua cái khó này ạ. nếu thấy ngại xin gửi email dùm em ạ. maithangmobi@gmail.com
cám ơn

 

[Hoàng Trọng Nghĩa]

chào các anh/chị

file excel em gửi đính kèm nó có chức năng phân loại theo từng kiểu. nhưng em cần thêm chức năng sắp sếp theo giá bán (tăng dần từ A=>z) khi mình bấm vào nút "LỌC"
nhờ anh chị giúp dùm em. cảm ơn

Copy code dưới đây và thay thế code cũ trong file của bạn:

Sub xuat()
Application.ScreenUpdating = False
Dim DL(), i As Long, k, d As Object, loai(), data As Range, kieusim(), tim As Range, kq(), ii, kq2(1 To 10000, 1 To 14), j
Set d = CreateObject("scripting.dictionary")
If Sheet8.[P1] = "" Or Len(Sheet8.[P1]) > 2 Then
   MsgBox "Kiem Tra Lai Thong Tin Tai P1"
   End
End If
Sheet8.[A2:N6000].Clear
With Sheets(Sheet8.[P1].Value)
   .Range(.[A1], .[D65536].End(3).Offset(, 15)).AdvancedFilter 2, , Sheet8.[A1:M1]
End With


With Sheet8
[COLOR=#ff0000]    .Range(.[A2], .[A65536].End(3)).Resize(, 13).Sort .[M1], xlAscending, .[D1], , xlAscending, .[C1], xlAscending[/COLOR]
    .Range(.Cells(.[C65536].End(3).Offset(1).Row, 1), .[A65536].End(3).Offset(, 13)).Clear
    DL = .Range(.[M2], .[M65536].End(3)).Value
    
    For i = 1 To UBound(DL)
       If DL(i, 1) <> "" And Not d.exists(DL(i, 1)) Then
          d.Add DL(i, 1), ""
       End If
    Next
    loai = d.keys
End With




ActiveSheet.UsedRange.Offset(1).RowHeight = 25
kieusim = Sheet3.Range(Sheet3.[A2], Sheet3.[B65536].End(3)).Value
kq = Range([A2], [A65536].End(3)).Resize(, 14).Value
With CreateObject("vbscript.regexp")
   .Global = True
   .Pattern = "\d"
For i = 1 To UBound(kieusim)
   For ii = 1 To UBound(kq)
      If .Replace(kq(ii, 7), "") = kieusim(i, 1) Then
         kq(ii, 14) = kieusim(i, 2)
      End If
   Next
Next
End With
[A2].Resize(ii - 1, 14) = kq


Set data = Range([A2], [N65536].End(3))
For i = 0 To UBound(loai)
   With data
      .AutoFilter 13, loai(i)
      .Sort data(1, 14)
      .AutoFilter
   End With
Next
DL = Range([A1], [A65536].End(3).Offset(1)).Resize(, 14).Value
For i = 1 To UBound(DL) - 1
   If DL(i, 14) = DL(i + 1, 14) Then
      k = k + 1
      For j = 1 To 14
         kq2(k, j) = DL(i, j)
      Next
   Else
      k = k + 1
      For j = 1 To 14
         kq2(k, j) = DL(i, j)
      Next
      If DL(i + 1, 14) <> "" Then
         k = k + 1
         kq2(k, 3) = DL(i + 1, 14)
         kq2(k, 1) = [P1]
      End If
   End If
Next
[H2].Resize(k).NumberFormat = "@"
[A1].Resize(k, 14) = kq2
Columns("N:N").Clear
[C2:C10000].Interior.ColorIndex = xlNone
Range([B2], [B65536].End(3)).SpecialCells(4).Offset(, 1).Interior.ColorIndex = 6
[A1].CurrentRegion.Borders.Value = 1
[A1].CurrentRegion.Font.Size = 18


Application.ScreenUpdating = True
End Sub

 

[Hoàng Trọng Nghĩa]

Bạn chạy Sub này. sau khi bạn lọc bằng code gì đó có trong file

Sub Sort_GPE()
Dim J As Long, K As Long, F As Long
Dim Z As Long, Y As Long, I As Long
J = Sheet8.Range("D65000").End(3).Row
Z = Sheet8.Range("D1").End(4).Row
Sheet8.Range("A3:M" & Z).Sort Sheet8.Range("D3:D" & Z), xlAscending
    For I = 0 To J Step K
        K = Sheet8.Range("D" & K + 2).End(4).Row
        If K = J Then Exit Sub
        'On Error Resume Next
        F = Sheet8.Range("D" & K + 2).End(4).Row
        Sheet8.Range("A" & K + 2 & ":M" & F).Sort Sheet8.Range("D" & K + 2 & ":D" & F), xlAscending
    Next I
End Sub

Ghê quá nhỉ? Sort trong For ... Next nữa chứ! Người ta sort 1 lần thôi, còn lại code xử lý!

 

[doveandrose]

Hi. Code trong file đó mình không dám đụng tới.... vì có hiểu nó làm kía gì đâu mà sửa...hehe Cho nên mới Xử lý cái Sort khi bạn ấy đã có kết quả với code cũ thôi (Xử lý trên kết quả thôi mà...)

không hiểu code trong file làm cái gì vậy sao có thẻ điện thoại đây ? há há

 

[Hoàng Trọng Nghĩa]

Hi. Code trong file đó mình không dám đụng tới.... vì có hiểu nó làm kía gì đâu mà sửa...hehe Cho nên mới Xử lý cái Sort khi bạn ấy đã có kết quả với code cũ thôi (Xử lý trên kết quả thôi mà...)

Trong code của bạn ấy có đến 2 lần sort, trong khi tôi chỉ sort 1 lần với 3 điều kiện, còn code của bạn thêm vào thì cái khoảng nào cũng sort. Dzị mới ghia chứ!

 

[Hoàng Trọng Nghĩa]

Há há... hiểu làm chi cho mệt óc vậy bạn, Cứ bám cái tiêu đề là làm sao ra kết quả cuối cùng là Sort.... là có kía thẻ 100k rồi.....

Kèo thơm ở bài số 3 nè! kkakakakaka

xin lỗi các bác em đã quá lời ạ

 

[titanic]

cảm ơn anh hoàng ạ, em không hiểu về vba nên không hiểu code lắm . nhưng nó rất đúng ý của em. em hậu tạ anh sao đây ạ. cho xin số điện thoại ạ, hôm nay khuyến mãi viettel. anh co so viettel thi gui tin nhan cho em nhe.

 

[VetMini]

cảm ơn anh hoàng ạ, em không hiểu về vba nên không hiểu code lắm . nhưng nó rất đúng ý của em. em hậu tạ anh sao đây ạ. cho xin số điện thoại ạ, hôm nay khuyến mãi viettel. anh co so viettel thi gui tin nhan cho em nhe.

Lỡ ngày mai khám phá ra phải thêm chút nữa thì có trả thẻ lại hôn?
Nếu thẻ biếu đứt rồi thì làm thêm 1 chút có lấy thêm 1 thẻ nữa hôn?

 

[titanic]

anh
Hoàng Trọng Nghĩa

nhắn tin cho em nhe.

 

[Hoàng Trọng Nghĩa]

anh
Hoàng Trọng Nghĩa

nhắn tin cho em nhe.

Cám ơn ý tốt của bạn, tôi ghi nhận, bạn không cần phải hậu tạ gì đâu nhé, giúp nhau cùng tiến bộ thôi. Nếu ở SG thì gặp nhau làm vài ly (share đều), còn không thì nhấn nút CÁM ƠN là OK.

 

[titanic]

em ở tỉnh an giang , thấy anh viet code hay quá. thấy cũng ngưởn mộ quá. học vba có khó không anh ?

 

[Hoàng Trọng Nghĩa]

em ở tỉnh an giang , thấy anh viet code hay quá. thấy cũng ngưởn mộ quá. học vba có khó không anh ?

Có đam mê thì có thành công bạn à. Vậy là gần nhà anh Ba Tê rồi đó. Có ở Long Xuyên không?

 

[VetMini]

Có người vì đam mê. Cũng có người vì bắt buộc phải làm.
Học lập trình cũng như học làm toán nhân chia. Hồi còn học lớp 1, tôi mất cả tháng để học thuộc lòng bảng cửu chương. Sau đó học toán nhân đến cả hết năm. Sang lớp 2 mới học toán chia. Đếm lại những bài tập trải qua là con số khổng lồ.
Có đam mê gì đâu. Chỉ là hồi nhỏ mình tin là học thì phải như vậy, không có cách nào khác.