Nhờ các Cao thủ viết giúp em code VBA lọc và tính tổng (1 người xem)

[Chian91]

Em muốn lọc dữ liệu trong sheet1 sang sheet2 và tính tổng các dữ liệu trùng nhau trong sheet1. Rất mong được sự giúp đỡ. Em cảm ơn nhiều

 

[quanluu]

Em muốn lọc dữ liệu trong sheet1 sang sheet2 và tính tổng các dữ liệu trùng nhau trong sheet1. Rất mong được sự giúp đỡ. Em cảm ơn nhiều

E4=SUMIF(Sheet1!$C$4:$C$275,Sheet2!C4,Sheet1!$E$4:$E$275)
Fill xuống

 

[Chian91]

E4=SUMIF(Sheet1!$C$4:$C$275,Sheet2!C4,Sheet1!$E$4:$E$275)
Fill xuống

Em muốn code VBA anh ơi!

 

[giaiphap]

Bạn thử dùng code này

Sub GPE()
Dim Dic As Object, Tmp As String
Dim i As Long, j As Long, k As Long
Dim Arr, dArr
Arr = Range(Sheet1.[C4], Sheet1.[C4].End(xlDown)).Resize(, 3)
ReDim dArr(1 To UBound(Arr, 1), 1 To 3)
Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        For i = 1 To UBound(Arr, 1)
            Tmp = Arr(i, 1)
            If Not .Exists(Tmp) Then
                k = k + 1
                .Add Tmp, k
                For j = 1 To UBound(Arr, 2)
                    dArr(k, j) = Arr(i, j)
                Next j
            Else
                dArr(.Item(Tmp), 3) = dArr(.Item(Tmp), 3) + Arr(i, 3)
            End If
        Next i
    End With
    Sheet2.Range("C4:C65000").Clear
    Sheet2.Range("C4").Resize(k, 3) = dArr
    Sheet2.Range("C4:E" & (k + 3)).Borders.LineStyle = 1
End Sub

 

[quanluu]

Em muốn code VBA anh ơi!

Để code đơn giản thì bạn chền công thức trong code, sau khi fill ct xong thì thêm 1 dòng để chuyển từ công thức sang value
Range(xx).value = range(xx).value

Sub run()
Dim i As Integer, last As Integer
last = Sheets("Sheet1").Range("C" & Rows.Count).End(3).Row
For i = 4 To Range("D" & Rows.Count).End(3).Row
    Cells(i, 5) = "=SUMIF(Sheet1!$C$" & i & ":$C$" & last & ",Sheet2!C" & i & ",Sheet1!$E$" & i & ": $E$" & last & ")"
Next
Range("E4:E" & Range("D" & Rows.Count).End(3).Row).Value = Range("E4:E" & Range("D" & Rows.Count).End(3).Row).Value
End Sub
[

 

[Chian91]

Bạn thử dùng code này

Sub GPE()
Dim Dic As Object, Tmp As String
Dim i As Long, j As Long, k As Long
Dim Arr, dArr
Arr = Range(Sheet1.[C4], Sheet1.[C4].End(xlDown)).Resize(, 3)
ReDim dArr(1 To UBound(Arr, 1), 1 To 3)
Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        For i = 1 To UBound(Arr, 1)
            Tmp = Arr(i, 1)
            If Not .Exists(Tmp) Then
                k = k + 1
                .Add Tmp, k
                For j = 1 To UBound(Arr, 2)
                    dArr(k, j) = Arr(i, j)
                Next j
            Else
                dArr(.Item(Tmp), 3) = dArr(.Item(Tmp), 3) + Arr(i, 3)
            End If
        Next i
    End With
    Sheet2.Range("C4:C65000").Clear
    Sheet2.Range("C4").Resize(k, 3) = dArr
    Sheet2.Range("C4:E" & (k + 3)).Borders.LineStyle = 1
End Sub

Em copy code mã trên khi chạy thấy báo lỗi 400 em k hiểu.
Nội dung của em gồm 2 vấn đề:
1. Lọc các dữ liệu trùng nhau trong cột C của Sheet1 sang cột C của Sheet2
2. Tính tổng các dữ liệu giống nhau ở Sheet 1 sang sheet2.
Mong các bác giúp em!

 

[quanluu]

Em copy code mã trên khi chạy thấy báo lỗi 400 em k hiểu.
Nội dung của em gồm 2 vấn đề:
1. Lọc các dữ liệu trùng nhau trong cột C của Sheet1 sang cột C của Sheet2
2. Tính tổng các dữ liệu giống nhau ở Sheet 1 sang sheet2.
Mong các bác giúp em!

Bạn thử code này coi. Tận dụng ghi macro. Chạy code Khi đang chọn sheet 2 nhé
Sory bác giaiphap vì đã xen ngang

Sub run()
Dim i As Integer, last As Integer
Application.ScreenUpdating = False
    last = Sheets("Sheet1").Range("C" & Rows.Count).End(3).Row
    Sheets("Sheet1").Range("C4:D" & last).Copy Range("C4")
    Range("$C$4:$D$" & last).RemoveDuplicates Columns:=1, Header:=xlNo
    For i = 4 To Range("D" & Rows.Count).End(3).Row
        Cells(i, 5) = "=SUMIF(Sheet1!$C$4:$C$" & last & ",Sheet2!C" & i & ",Sheet1!$E$4:$E$" & last & ")"
    Next
    Range("E4:E" & Range("D" & Rows.Count).End(3).Row).Value = Range("E4:E" & Range("D" & Rows.Count).End(3).Row).Value
Application.ScreenUpdating = True
End Sub

 

[Chian91]

Bạn thử code này coi. Tận dụng ghi macro. Chạy code Khi đang chọn sheet 2 nhé
Sory bác giaiphap vì đã xen ngang

Sub run()
Dim i As Integer, last As Integer
Application.ScreenUpdating = False
    last = Sheets("Sheet1").Range("C" & Rows.Count).End(3).Row
    Sheets("Sheet1").Range("C4:D" & last).Copy Range("C4")
    Range("$C$4:$D$" & last).RemoveDuplicates Columns:=1, Header:=xlNo
    For i = 4 To Range("D" & Rows.Count).End(3).Row
        Cells(i, 5) = "=SUMIF(Sheet1!$C$4:$C$" & last & ",Sheet2!C" & i & ",Sheet1!$E$4:$E$" & last & ")"
    Next
    Range("E4:E" & Range("D" & Rows.Count).End(3).Row).Value = Range("E4:E" & Range("D" & Rows.Count).End(3).Row).Value
Application.ScreenUpdating = True
End Sub

Nhờ anh giải thích giúp em dòng này với ạ:
For i = 4 To Range("D" & Rows.Count).End(3).Row
Cells(i, 5) = "=SUMIF(Sheet1!$C$4:$C$" & last & ",Sheet2!C" & i & ",Sheet1!$E$4:$E$" & last & ")"

 

[quanluu]

Nhờ anh giải thích giúp em dòng này với ạ:
For i = 4 To Range("D" & Rows.Count).End(3).Row
Cells(i, 5) = "=SUMIF(Sheet1!$C$4:$C$" & last & ",Sheet2!C" & i & ",Sheet1!$E$4:$E$" & last & ")"

Xét từ dòng thứ 4 đến dòng cuối (mình lấy cột D làm chuẩn, để xem dòng cuối ở đâu)
Lần lượt các dòng: Ta điền công thức cho các cells cột E, ct ở#2. (cột 5: chính là cột E)

 

[Chian91]

Nhờ anh sửa giúp em COD khi em ấn nút TỔNG HỢP VẬT LIỆU cứ bị báo lỗi, thanks!

 

[Chian91]

Nhờ anh sửa giúp em, e click vào nút TỔNG HỢP VẬT LIỆU cứ bị báo lỗi, thanks anh nhiều!

 

[quanluu]

Nhờ anh sửa giúp em, e click vào nút TỔNG HỢP VẬT LIỆU cứ bị báo lỗi, thanks anh nhiều!

Vấn đề của bạn là: Sheets("Sheet8"). Ko có cái sheet nào tên như thế nhé.