Hỏi về tự động cập nhật dữ liệu bằng VBA?

[Duong_VBA]

Nhờ thầy anhtuan1066 giúp đỡ!

Em gửi file và câu hỏi kèm theo?
Cảm ơn thầy!

 

[anhtuan1066]

Trời... xin đừng gọi thế chứ bạn... Tôi cũng là ngưới đang học chứ ko phải cao thủ như bạn tưởng đâu... (kiếm mấy ông có nick màu xanh lá, màu vàng và màu đỏ ấy... Toàn là đại tổ sư)
Mà nè... với yêu cầu này thì cần gì VBA nhỉ... sao bạn ko dùng công thức cho gọn... Tại cell P3 gõ công thức:

=SUMPRODUCT(($B$3:$B$13=N3)*($C$3:$C$13=O3)*($D$3:$D$13))+SUMPRODUCT(($H$3:$H$13=N3)*($I$3:$I$13=O3)*($J$3:$J$13))

Hoặc công thức:

=SUMPRODUCT(($B$3:$B$13&$C$3:$C$13=N3&O3)*($D$3:$D$13))+SUMPRODUCT(($H$3:$H$13&$I$3:$I$13=N3&O3)*($J$3:$J$13))

 

[tedaynui]

He he, mình cũng hỏng rành nhưng tham gia cho vui vậy.

Nếu bạn nhiệt huyết với VBA vậy thì bạn có thể làm 1 trong các cách sau :
1/ Dựa vào công thức dùng SUMPRODUCT của Anh Tuấn, bạn chuyển thành VBA. Tức là dùng Evaluate hoặc WorksheetFunction.SumProduct
Lưu ý với cách này, bạn đặt Name động sẽ chạy nhanh hơn

2/ Bạn dùng thử đoạn code sau xem thế nào nhé

Sub TinhTong()
Dim i As Long, ii As Long, iii As Long
Dim Tong As Long
Dim iTem As String, Loai As String
For i = 3 To WorksheetFunction.CountA(Range("N:N")) + 1
    iTem = Range("N" & i)
    Loai = Range("O" & i)
    Tong = 0
    For ii = 3 To WorksheetFunction.CountA(Range("B:B")) + 1
        If Range("B" & ii) = iTem And Range("C" & ii) = Loai Then Tong = Tong + Range("D" & ii)
    Next ii
    
    For iii = 3 To WorksheetFunction.CountA(Range("H:H")) + 1
        If Range("H" & iii) = iTem And Range("I" & iii) = Loai Then Tong = Tong + Range("J" & iii)
    Next iii
    
    Range("P" & i) = Tong
Next i
End Sub

TDN

 

[Duong_VBA]

Cảm ơn tedaynui !
Code trên cộng không đúng và điều quan trọng là khi nhập thêm thì nó không cập nhật, mình muốn nó phải cập nhật thêm và tính lại tổng sau khi cập nhật!
Thank!

 

[tedaynui]

Cảm ơn tedaynui !
Code trên cộng không đúng và điều quan trọng là khi nhập thêm thì nó không cập nhật, mình muốn nó phải cập nhật thêm và tính lại tổng sau khi cập nhật!
Thank!

Mình đã Test lại nhưng vẫn cho kết quả như ý.

Bạn lưu ý, Đoạn code trên không phải là Function nên không tự cập nhật kết quả. Nếu bạn thay đổi giá trị thì bạn cần phải chạy lại code trên thì kết quả mới cập nhật lại. Nếu bạn có vài nghìn dòng trở lên thì dùng cách này chỉ ghi kết quả, File sẽ chạy nhẹ nhàng và dung lượng cũng nhỏ hơn Sumproduct rất nhiều.

Đoạn code trên bạn đặt trong Module nhé.

TDN

 

[Lam_A0]

Sub TinhTong()
Dim i As Long, ii As Long, iii As Long
Dim Tong As Long
Dim iTem As String, Loai As String
For i = 3 To WorksheetFunction.CountA(Range("N:N")) + 1
    iTem = Range("N" & i)
    Loai = Range("O" & i)
    Tong = 0
    For ii = 3 To WorksheetFunction.CountA(Range("B:B")) + 1
        If Range("B" & ii) = iTem And Range("C" & ii) = Loai Then Tong = Tong + [COLOR=Red]Range("D" & i)[/COLOR]
    Next ii
    
    For iii = 3 To WorksheetFunction.CountA(Range("H:H")) + 1
        If Range("H" & iii) = iTem And Range("I" & iii) = Loai Then Tong = Tong + [COLOR=Red]Range("J" & i)[/COLOR]
    Next iii
    
    Range("P" & i) = Tong
Next i
End Sub

To tedaynui: Em nghĩ có lỗi thật! Phải sửa 2 đoạn bôi đỏ trên thành:
Range("D" & ii)
Range("J" & iii)
To Duong_VBA: Để cập nhật, bạn có thể tạo một button trên sheet1, để macro trong module, rồi assign macro này vào button đó, mỗi lần thay đổi dữ liệu chỉ cần click vào button này là được.
Thân!

 

[SA_DQ]

Xin phép bổ sung:

To Duong_VBA: Để cập nhật, bạn có thể tạo một button trên sheet1, để macro trong module, rồi assign macro này vào button đó, mỗi lần thay đổi dữ liệu chỉ cần click vào button này là được.

Cách nữa để các bạn tham khảo:

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Rng As Range
 
 Set Rng = Union(Range("D3:D" & Range("D65432").End(xlUp).Row + 1), _
     Range("J3:J" & Range("J65432").End(xlUp).Row + 1))
 If Not Intersect(Target, Rng) Is Nothing Then
    TinhTong
 End If
End Sub

Theo cách này, hễ chúng ta đụng vô 2 cột chứa dữ liệu 'D' & 'J' thì macro TinhTong của TDN sẽ cập nhật cho bạn lại các tổng;



To TDN: Theo mình nên dùng hàm Ucase() nhằm khắc phục tình trạng người nhập có thể lẫn chữ thường trong chữ bông!

Thân ái!!

 

[Lam_A0]

Theo cách này, hễ chúng ta đụng vô 2 cột chứa dữ liệu 'D' & 'J' thì macro TinhTong của TDN sẽ cập nhật cho bạn lại các tổng;

Cách này có một điểm không hay là đôi khi nó tự thay đổi mà mình không biết, nhất là đối với những người sử dụng thuần túy. Nói chung là em thích dùng cách của em hơn, khi chắc chắn về việc thay đổi thì click...

 

[tedaynui]

To LAM_A0
Cám ơn bạn, đúng như bạn nhận xét. Mình đã chỉnh lại

To Bác SA

To TDN: Theo mình nên dùng hàm Ucase() nhằm khắc phục tình trạng người nhập có thể lẫn chữ thường trong chữ bông!
Thân ái!!

Dạ, em cũng tính dùng Ucase nhưng thấy trong file của tác giả hình như có phân biệt chữ bông và chữ thường nên thôi. Hi hi

Thân !

 

[Duong gia]

Cách nữa để các bạn tham khảo:

Private Sub Worksheet_Change(ByVal Target As Range) Dim Rng As Range   Set Rng = Union(Range("D3:D" & Range("D65432").End(xlUp).Row + 1), _ Range("J3:J" & Range("J65432").End(xlUp).Row + 1)) If Not Intersect(Target, Rng) Is Nothing Then TinhTong End If End Sub

Theo cách này, hễ chúng ta đụng vô 2 cột chứa dữ liệu 'D' & 'J' thì macro TinhTong của TDN sẽ cập nhật cho bạn lại các tổng; To TDN: Theo mình nên dùng hàm Ucase() nhằm khắc phục tình trạng người nhập có thể lẫn chữ thường trong chữ bông! Thân ái!!

Mình theo hướng dẫn của các Bác sao nó không chay. Nhờ các Bác sửa giúp (mở file đính kèm)

 

[anhtuan1066]

Hình như trong file này nó chỉ tính tổng thôi chứ ko LỌC... giống cách làm bằng SUMPRODUCT... tức là đầu tiên bạn phải tự điền dử liệu vào cột N và cột O trước, sau đó mới bấm nút Command Button
ANH TUẤN

 

[SA_DQ]

Chưa có bảng ban đầu!

Mình theo hướng dẫn của các Bác sao nó không chay. Nhờ các Bác sửa giúp (mở file đính kèm)

Bạn thử Copy vùng 'H3:J6' đến vùng 'N3'
Rồi sau đó thử sửa vài số liệu xem sao!

Như còn muốn nó Copy (như bạn) thì phải macro thứ 2 nữa & đợi thôi, nếu gật đầu!!!

 

[tedaynui]

Mình theo hướng dẫn của các Bác sao nó không chay. Nhờ các Bác sửa giúp (mở file đính kèm)

File của bạn không chạy vì ITEM ở cột N và Loại ở cột O chưa có dữ liệu.

TDN

 

[Duong_VBA]

Rất cảm ơn các thầy đã chỉ giáo, nhưng vấn đề là nó vẫn không cập nhật các loại vào các cột từ M đến Q, mong các thầy tiếp tục giúp! (Tiện thể ở cột Q các thầy đếm luôn số lần xuất hiện mỗi loại hộ em với) Thank!

 

[anhtuan1066]

Ngay từ đầu tôi đã nghĩ là sẽ làm 1 code vừa LOC vừa TONG.. Thuật toán vẫn có trong đầu, tuy nhiên độ nhạy cảm kém nên ko biết "nói" thế nào? Nếu chỉ có 1 bảng thì tôi tin là mình có thể làm dc dựa vào vòng lập FOR mà các cao thủ đã dạy... 2 bảng tách biệt thì khó quá (ít nhất đối với tôi)

 

[Duong_VBA]

Thầy Tuấn cho Code với 1 bảng cũng được (Phải cập nhật) Thank thầy!

 

[tigertiger]

Mấy hôm nay bận ko lên được diễn đàn, trưa nay tranh thủ, thì

oh, VBA code trong File Duong_VBA up lên là do TigerTiger viết - tối nay TigerTiger sẽ sửa lại code cho bạn -> Ok, sáng mai xem nhé

 

[SA_DQ]

Xong rồi đây!

Option Explicit:            Option Base 1
Sub CopyAndSum()
 Dim Rng As Range, lRow As Long
  1
 Range(Cells(1, 24), Cells(Cells(65432, 26).End(xlUp).Row, 26)).ClearContents
 2
 Set Rng = Range(Cells(2, 2), Cells(Cells(65432, 4).End(xlUp).Row, 4))
 Rng.Copy Destination:=Cells(1, 24)
 5
 Set Rng = Range(Cells(3, 8), Cells(Cells(65432, 10).End(xlUp).Row + 1, 10))
 Rng.Copy Destination:=Cells(Cells(65432, 24).End(xlUp).Row + 1, 24)
 7
 Set Rng = Range(Cells(1, 24), Cells(Cells(65432, 26).End(xlUp).Row, 26))
 Rng.Select
 Selection.Sort Key1:=Range("X2"), Order1:=xlAscending, Key2:=Range("Y2") _
    , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
    False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
    :=xlSortNormal
 lRow = Cells(Cells(65432, 24).End(xlUp).Row, 24).Row
 ReDim Mang(lRow, 3):           Dim lDem As Long, iJ As Long
 For iJ = 2 To lRow
    With Cells(iJ, 24)
        If iJ = 2 Then
            lDem = 1:                           Mang(lDem, 1) = .Value
            Mang(lDem, 2) = .Offset(, 1):       Mang(lDem, 3) = .Offset(, 2)
        Else
            If (.Value = Mang(lDem, 1) And .Offset(, 1) <> Mang(lDem, 2)) Or _
                .Value <> Mang(lDem, 1) Then
                lDem = 1 + lDem:                Mang(lDem, 1) = .Value
                Mang(lDem, 2) = .Offset(, 1):   Mang(lDem, 3) = .Offset(, 2)
            ElseIf .Value = Mang(lDem, 1) And .Offset(, 1) = Mang(lDem, 2) Then '*!*'
               Mang(lDem, 3) = Mang(lDem, 3) + .Offset(, 2)
            End If
        End If
    End With
 Next iJ
 For iJ = 1 To lDem
    With Cells(iJ + 2, 14)
        .Value = Mang(iJ, 1):               .Offset(, -1) = iJ
        .Offset(, 1) = Mang(iJ, 2):         .Offset(, 2) = Mang(iJ, 3)
    End With
 Next iJ
 Range(Cells(1, 24), Cells(Cells(65432, 26).End(xlUp).Row, 26)).ClearContents

End Sub

To Tuấn:
* 2 bảng riêng biệt thì chép chúng => 1 (bằng các dòng 2-7 như trên)
* Có dòng lệnh nào chưa rõ, Tuấn sẽ được hướng dẫn sau, nha!!!
To Tác gia Topic:
Nhớ sửa lại tên Sub nếu cần!

 

[tigertiger]

Vừa Lọc vừa tính Tổng

Vừa Lọc vừa tính Tổng

TigerTiger đã giúp sửa Code đó rồi, mọi thứ đều động (xét cả 2 bảng) tính tổng SL như mong muốn Duong_VBA

Xem trong file gửi kèm


Chúc Thành Công

 

[Duong_VBA]

Thầy tigertiger giỏi thật! Thank thầy nhiều!
Thầy hộ nốt cái này nhé!
Tại cột Q em muốn đếm số lần Item xuất hiện. Vi dụ Item A; Loai 1 có 4 lần thi cột Q báo 4 (Hiện nay tại Q báo giá trị sau cùng của cột FREI)