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 ô. (2 người xem)

chulun287 · 24/12/22

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 · 24/12/22

chulun287 đã viết:
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 · 24/12/22

chulun287 đã viết:
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:

Mã:

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 · 24/12/22

Hoàng Nhật Phương đã viết:

Bạn tham khảo:

Mã:

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 · 24/12/22

Hoàng Nhật Phương đã viết:

Bạn tham khảo:

Mã:

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 · 24/12/22

HieuCD đã viết:
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 ạ:

Mã:

    ....
    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 · 24/12/22

Hoàng Nhật Phương đã viết:

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 ạ:

Mã:

    ....
    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 · 24/12/22

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 · 24/12/22

HieuCD đã viết:
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 ^^

chulun287 đã viết:
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 · 24/12/22

chulun287 đã viết:
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 · 24/12/22

Hoàng Tuấn 868 đã viết:
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 · 24/12/22

chulun287 đã viết:
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 · 24/12/22

Hoàng Tuấn 868 đã viết:
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

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 ô. (2 người xem)

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

chulun287

Thành viên mới

Hoàng Tuấn 868

Đăng ký hôm qua

Hoàng Nhật Phương

Thành viên gắn bó

Hoàng Tuấn 868

Đăng ký hôm qua

HieuCD

Chuyên gia GPE

Hoàng Nhật Phương

Thành viên gắn bó

HieuCD

Chuyên gia GPE

chulun287

Thành viên mới

Hoàng Nhật Phương

Thành viên gắn bó

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ụ)

Hoàng Tuấn 868

Đăng ký hôm qua

chulun287

Thành viên mới

File đính kèm

Hoàng Tuấn 868

Đăng ký hôm qua

File đính kèm

chulun287

Thành viên mới

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

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