Các bạn giúp mình lọc & xếp dữ liệu theo 1 trật tự giúp với (1 người xem)

[SA_DQ]

Các bạn giúp mình lọc & xếp dữ liệu theo 1 trật tự với

Xin các bạn xem thêm theo hình:


Chúc các bạn vui vẻ nhân ngày cuối tuần

 

[Lê Duy Thương]

Xin các bạn xem thêm theo hình:
View attachment 81688

Chúc các bạn vui vẻ nhân ngày cuối tuần

cái này dùng công thức cũng ok mà bác HYen
còn code thì em dùng cái record macro này

Sub loc()
On Error Resume Next
Application.ScreenUpdating = 0
 With ThisWorkbook
        Sheet1.Range("F4:h5000").Clear
        .Names.Add "temp1", "=IFERROR(--SUBSTITUTE(UPPER(IF(LEFT(Sheet1!R3C1:R5000C1,LEN(Sheet1!R3C))=Sheet1!R3C,Sheet1!R3C1:R5000C1,"""")),Sheet1!R3C,""""),"""")"
        .Names.Add "temp2", "=IFERROR(Sheet1!R3C&TEXT(SMALL(temp1,ROW(Sheet1!R[-3])),""00""),"""")"
        [f4].FormulaR1C1 = "=temp2"
        [f4].AutoFill Destination:=Range("F4:H4")
        Range("F4:H4").AutoFill Destination:=Range("F4:H" & [a5000].End(3).Row)
        Range("F4:H" & [a5000].End(3).Row).Value = Range("F4:H" & [a5000].End(3).Row).Value
        .Names("temp1").Delete
        .Names("temp2").Delete
      End With
    Application.ScreenUpdating = 1
End Sub

mong các sư phụ rút gọn giùm em cái names cho ngắn đi chứ nhìn như vậy xấu quá, bác cò già chê là em phải bị phạt 2 lon thì nguy
ẹc ẹc

 

[SA_DQ]

Sao mình chạy trên E2003 nó lại báo lỗi, nhĩ?

Vùng đó lí ra là kết quả thì nhận được toàn là #NAME?

Các bạn khác có thấy vậy không?

 

[Lê Duy Thương]

Vùng đó lí ra là kết quả thì nhận được toàn là #NAME?

Các bạn khác có thấy vậy không?

ý chết em dùng hàng mới 2010 nên không để ý đến cái vụ này
vậy thì

Sub loc()On Error Resume Next
Application.ScreenUpdating = 0
 With ThisWorkbook
        Sheet1.Range("F4:h5000").Clear
        .Names.Add "temp1", "=IF(ISERROR(--SUBSTITUTE(UPPER(IF(LEFT(Sheet1!R3C1:R5000C1,LEN(Sheet1!R3C))=Sheet1!R3C,Sheet1!R3C1:R5000C1,"""")),Sheet1!R3C,"""")),"""",--SUBSTITUTE(UPPER(IF(LEFT(Sheet1!R3C1:R5000C1,LEN(Sheet1!R3C))=Sheet1!R3C,Sheet1!R3C1:R5000C1,"""")),Sheet1!R3C,""""))"
        .Names.Add "temp2", "=IF(ISERROR(Sheet1!R3C&TEXT(SMALL(temp1,ROW(Sheet1!R[-3])),""00"")),"""",Sheet1!R3C&TEXT(SMALL(temp1,ROW(Sheet1!R[-3])),""00""))"
        [f4].FormulaR1C1 = "=temp2"
        [f4].AutoFill Destination:=Range("F4:H4")
        Range("F4:H4").AutoFill Destination:=Range("F4:H" & [a5000].End(3).Row)
        Range("F4:H" & [a5000].End(3).Row).Value = Range("F4:H" & [a5000].End(3).Row).Value
        .Names("temp1").Delete
        .Names("temp2").Delete
      End With
    Application.ScreenUpdating = 1
End Sub

bác có thể chỉ cho em cái name có thể rút gọn được không ? , hay có cách nào ngắn ngọn hơn không ? chứ record nhìn ghê quá

 

[huuthang_bd]

Code thì dùng mảng cho nhanh.

Sub GPE()
Dim Chuan, DuLieu, KQua, Dic, Tam As String, i As Long, j As Long, k As Long
Set Dic = CreateObject("Scripting.Dictionary")
Chuan = Range([B65536].End(xlUp), [B3]).Value
DuLieu = Range([A65536].End(xlUp), [A3]).Value
ReDim KQua(1 To UBound(DuLieu, 1), 1 To UBound(Chuan, 1))
For i = 1 To UBound(Chuan, 1)
    KQua(1, i) = Chuan(i, 1)
    Dic.Add Chuan(i, 1), 1
    For j = 1 To UBound(DuLieu, 1)
        If DuLieu(j, 1) Like Chuan(i, 1) & "*" Then
            Dic.Item(Chuan(i, 1)) = Dic.Item(Chuan(i, 1)) + 1
            KQua(Dic.Item(Chuan(i, 1)), i) = DuLieu(j, 1)
        End If
    Next
    For j = 2 To Dic.Item(Chuan(i, 1)) - 1
        For k = j + 1 To Dic.Item(Chuan(i, 1))
            If KQua(j, i) > KQua(k, i) Then
                Tam = KQua(j, i):   KQua(j, i) = KQua(k, i):    KQua(k, i) = Tam
            End If
        Next
    Next
Next
[F3].CurrentRegion.ClearContents
[F3].Resize(UBound(KQua, 1), UBound(KQua, 2)).Value = KQua
End Sub