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 ô.

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài
Có
C

chulun287

Thành viên mới
Tham gia
21/12/13
Bài viết
4
Được thích
0
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.
1671851188912.png
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
Có lẽ hàm tự tạo sẽ thuận tiện hơn trong trường hợp này.
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
Sort theo cột D không cần dùng dic
 
Upvote 0
HieuCD đã viết:
Sort theo cột D không cần dùng dic
Nhấp chuột vào đây để mở rộng...
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
    ...
 
Upvote 0
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
    ...
Nhấp chuột vào đây để mở rộ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
....
 
Upvote 0
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 ạ. 1671859411225.png
 
Upvote 0
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
....
Nhấp chuột vào đây để mở rộng...
Ồ 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
Nhấp chuột vào đây để mở rộng...
Bạn tham khảo thêm chủ đề này xem:
www.giaiphapexcel.com

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 www.giaiphapexcel.com
 
Upvote 0
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

T
xin công thức tính kết chuyển lỗ vào thu nhập tính thuế TNDN trong nhiều năm
Trả lời
1
Đọc
49
HieuCD
H
solomon2211
PDF Tools giúp ghép, tách, xóa file pdf
    • Thích
    • Yêu thích
Trả lời
11
Đọc
245
YêuCN
Y
LuuAnh980
Vấn đề viết tắt trong Diễn Đàn.
    • Thích
    • Cười
2 3
Trả lời
50
Đọc
1K
SA_DQ
SA_DQ
Bùi Đức Dương
Vba sang Vb.net
Trả lời
4
Đọc
158
VetMini
V
ann266
Kế toán kho F&B
    • Cười
2
Trả lời
27
Đọc
438
ann266
ann266
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom