Hàm sắp xếp dữ liệu, loại bỏ ô trống và tính tổng các giá trị tham số theo ô. (1 người xem)

[chulun287]

Mình có một vấn đề thế này, mình có một phụ lục, có dữ liệu vài cột, có hàm nào công thức nào để sắp xếp dữ liệu như bên hình dưới không, mình đang dùng excel 2010. Cảm ơn mọi người.

 

[Hoàng Tuấn 868]

Mình có một vấn đề thế này, mình có một phụ lục, có dữ liệu vài cột, có hàm nào công thức nào để sắp xếp dữ liệu như bên hình dưới không, mình đang dùng excel 2010. Cảm ơn mọi người.
View attachment 285012

Bạn chịu khó tìm trên diễn đàn, có khá nhiều.

 

[Hoàng Nhật Phương]

Mình có một vấn đề thế này, mình có một phụ lục, có dữ liệu vài cột, có hàm nào công thức nào để sắp xếp dữ liệu như bên hình dưới không, mình đang dùng excel 2010. Cảm ơn mọi người.
View attachment 285012

Bạn tham khảo:

Option Explicit

Sub Run()

    Dim dic As Object
    Dim sheet As Worksheet
    Dim data As Variant, result As Variant, key As Variant
    Dim r As Integer, i As Integer, k As Integer
    Dim d As Double
   
    Set sheet = ThisWorkbook.ActiveSheet
    r = sheet.Cells(sheet.Rows.Count, "A").End(xlUp).Row
    sheet.Range("D1").Resize(10000, 7).ClearContents
    data = sheet.Range("A1:A" & r).Resize(, 2).Value
   
    sheet.Range("D1:D" & r).Resize(, 2).Value = data
    With sheet.Sort
        .SortFields.Clear
        .SortFields.Add key:=sheet.Range("D1"), Order:=xlAscending
        .SortFields.Add key:=sheet.Range("E1"), Order:=xlAscending
        .SetRange sheet.Range("D1:D" & r).Resize(, 2)
        .Header = xlNo
        .Apply
    End With
    data = sheet.Range("D1:D" & r).Resize(, 2).Value
    ReDim result(1 To r, 1 To 2)
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = TextCompare
   
    For i = LBound(data, 1) To UBound(data, 1)
        key = data(i, 1):   d = data(i, 2)
        If Len(key) > 0 Then
            If Not dic.Exists(key) Then
                k = k + 1
                dic.Add key, k
                result(k, 1) = key
                result(k, 2) = d
            Else
                r = dic.Item(key)
                result(r, 2) = result(r, 2) + d
            End If
        End If
    Next i
   
    sheet.Range("G1").Resize(k, 2).Value = result
   
End Sub

 

[Hoàng Tuấn 868]

Bạn tham khảo:

Option Explicit

Sub Run()

    Dim dic As Object
    Dim sheet As Worksheet
    Dim data As Variant, result As Variant, key As Variant
    Dim r As Integer, i As Integer, k As Integer
    Dim d As Double
   
    Set sheet = ThisWorkbook.ActiveSheet
    r = sheet.Cells(sheet.Rows.Count, "A").End(xlUp).Row
    sheet.Range("D1").Resize(10000, 7).ClearContents
    data = sheet.Range("A1:A" & r).Resize(, 2).Value
   
    sheet.Range("D1:D" & r).Resize(, 2).Value = data
    With sheet.Sort
        .SortFields.Clear
        .SortFields.Add key:=sheet.Range("D1"), Order:=xlAscending
        .SortFields.Add key:=sheet.Range("E1"), Order:=xlAscending
        .SetRange sheet.Range("D1:D" & r).Resize(, 2)
        .Header = xlNo
        .Apply
    End With
    data = sheet.Range("D1:D" & r).Resize(, 2).Value
    ReDim result(1 To r, 1 To 2)
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = TextCompare
   
    For i = LBound(data, 1) To UBound(data, 1)
        key = data(i, 1):   d = data(i, 2)
        If Len(key) > 0 Then
            If Not dic.Exists(key) Then
                k = k + 1
                dic.Add key, k
                result(k, 1) = key
                result(k, 2) = d
            Else
                r = dic.Item(key)
                result(r, 2) = result(r, 2) + d
            End If
        End If
    Next i
   
    sheet.Range("G1").Resize(k, 2).Value = result
   
End Sub

Có lẽ hàm tự tạo sẽ thuận tiện hơn trong trường hợp này.

 

[HieuCD]

Bạn tham khảo:

Option Explicit

Sub Run()

    Dim dic As Object
    Dim sheet As Worksheet
    Dim data As Variant, result As Variant, key As Variant
    Dim r As Integer, i As Integer, k As Integer
    Dim d As Double
  
    Set sheet = ThisWorkbook.ActiveSheet
    r = sheet.Cells(sheet.Rows.Count, "A").End(xlUp).Row
    sheet.Range("D1").Resize(10000, 7).ClearContents
    data = sheet.Range("A1:A" & r).Resize(, 2).Value
  
    sheet.Range("D1:D" & r).Resize(, 2).Value = data
    With sheet.Sort
        .SortFields.Clear
        .SortFields.Add key:=sheet.Range("D1"), Order:=xlAscending
        .SortFields.Add key:=sheet.Range("E1"), Order:=xlAscending
        .SetRange sheet.Range("D1:D" & r).Resize(, 2)
        .Header = xlNo
        .Apply
    End With
    data = sheet.Range("D1:D" & r).Resize(, 2).Value
    ReDim result(1 To r, 1 To 2)
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = TextCompare
  
    For i = LBound(data, 1) To UBound(data, 1)
        key = data(i, 1):   d = data(i, 2)
        If Len(key) > 0 Then
            If Not dic.Exists(key) Then
                k = k + 1
                dic.Add key, k
                result(k, 1) = key
                result(k, 2) = d
            Else
                r = dic.Item(key)
                result(r, 2) = result(r, 2) + d
            End If
        End If
    Next i
  
    sheet.Range("G1").Resize(k, 2).Value = result
  
End Sub

Sort theo cột D không cần dùng dic

 

[Hoàng Nhật Phương]

Sort theo cột D không cần dùng dic

Con chào bác ạ, bác khỏe không bác?
Con cảm ơn bác đã chỉ dẫn, con thấy cách làm của con hơi dài bác ạ:

    ....
    data = sheet.Range("D1:D" & r).Resize(, 2).Value
    ReDim result(1 To r, 1 To 2)
    For i = LBound(data, 1) To UBound(data, 1)
        key = data(i, 1):   d = data(i, 2)
        If Len(key) > 0 Then
            If k > 0 Then
                If result(k, 1) = key Then
                    result(k, 2) = result(k, 2) + d
                Else
                    k = k + 1
                    result(k, 1) = key
                    result(k, 2) = d
                End If
            Else
                k = k + 1
                result(k, 1) = key
                result(k, 2) = d
            End If
        End If
    Next i
    ...

 

[HieuCD]

Con chào bác ạ, bác khỏe không bác?
Con cảm ơn bác đã chỉ dẫn, con thấy cách làm của con hơi dài bác ạ:

    ....
    data = sheet.Range("D1:D" & r).Resize(, 2).Value
    ReDim result(1 To r, 1 To 2)
    For i = LBound(data, 1) To UBound(data, 1)
        key = data(i, 1):   d = data(i, 2)
        If Len(key) > 0 Then
            If k > 0 Then
                If result(k, 1) = key Then
                    result(k, 2) = result(k, 2) + d
                Else
                    k = k + 1
                    result(k, 1) = key
                    result(k, 2) = d
                End If
            Else
                k = k + 1
                result(k, 1) = key
                result(k, 2) = d
            End If
        End If
    Next i
    ...

Chỉ cần
....
For i = LBound(data, 1) To UBound(data, 1)
If data(i, 1) <> empty Then
If key <> data(i, 1) Then
key = data(i, 1)
k = k + 1
result(k, 1) = key
end if
result(k, 2) = result(k, 2) + data(i, 2)
End If
Next i
....

 

[chulun287]

Mình cảm ơn mọi người nhiều, VBA mọi người giỏi quá <3. Ý mình là có một hàm function, công thức nào ở ô G1 và H1 cho ra kết quả như hình ạ.

 

[Hoàng Nhật Phương]

Chỉ cần
....
For i = LBound(data, 1) To UBound(data, 1)
If data(i, 1) <> empty Then
If key <> data(i, 1) Then
key = data(i, 1)
k = k + 1
result(k, 1) = key
end if
result(k, 2) = result(k, 2) + data(i, 2)
End If
Next i
....

Ồ rất gọn luôn bác ơi ^^

Mình cảm ơn mọi người nhiều, VBA mọi người giỏi quá <3. Ý mình là có một hàm function, công thức nào ở ô G1 và H1 cho ra kết quả như hình ạ. View attachment 285021

Bạn tham khảo thêm chủ đề này xem:

Lọc duy nhất theo điều kiện, đồng thời sắp xếp tăng dần (không dùng cột phụ)

Bài toán của em dữ liệu thật có khoảng 400-500 dòng, yêu cầu bài toán: - Trích lọc duy nhất (loại bỏ ô trống và số 0); - Đồng thời với nó là sắp xếp dữ liệu theo thứ tự tăng dần Nhờ các bác giúp đỡ cho.

www.giaiphapexcel.com

 

[Hoàng Tuấn 868]

Mình cảm ơn mọi người nhiều, VBA mọi người giỏi quá <3. Ý mình là có một hàm function, công thức nào ở ô G1 và H1 cho ra kết quả như hình ạ. View attachment 285021

Hàm thì có, mỗi tội chẳng có file mà toàn ảnh.

 

[chulun287]

Hàm thì có, mỗi tội chẳng có file mà toàn ảnh.

hehe, Anh thông cảm tí, mới bước ra biển lớn nên sơ xuất ạ, em gửi file nhé.

 

[Hoàng Tuấn 868]

mới bước ra biển lớn

Thử kiểm tra lại xem sao. (Đây vẫn trong ao làng ta mà)

 

[chulun287]

Thử kiểm tra lại xem sao. (Đây vẫn trong ao làng ta mà)

Cảm ơn anh nhiều nhé, tuyệt vời <3