Chào mọi người, nhờ mọi người chỉ giúp em có thể dùng VBA viết công thức tính tổng theo tên ND.

[midi.mq]

Mục đích của em là viết công thức VBA tính tổng theo tên ND, có thể viết code tự động tính tổng thành tiền khi chuyển sang tên ND mới và chèn thêm hàng ngay sau đó được không ạ, cái này em có thấy phầm mềm của kế toán có. nhưng em không biết viết như thế nào, mong được sự hỗ trợ từ m,n. Em cảm ơn!

danh sách tổng hợp Nông Dân Mua hàng Hè Thu 2022

Số HĐ

Ngày

TT

SDT

TÊN ND

SĐT

dt

ĐỊA CHỈ

Mã hàng

Tên Hàng

ĐVT

SỐ LƯỢNG

ĐƠN GIÁ

THÀNH TIỀN

23​

5/16/2022​

Nguyễn Hồng Lĩnh

Nguyễn Trường Giang

20​

TOC

Tiêu ốc BL

gói

10​

34000​

340000​

23​

5/16/2022​

Nguyễn Hồng Lĩnh

Nguyễn Trường Giang

20​

MHAL

Mahal

chai

2​

18000​

80000​

23​

5/16/2022​

Nguyễn Hồng Lĩnh

Nguyễn Trường Giang

20​

TC 1000

Tiêu cỏ 1 Lít

chai

1​

34000​

34000​

23​

5/16/2022​

Nguyễn Hồng Lĩnh

Nguyễn Trường Giang

20​

CSAU

Chim Sâu

gói

10​

18000​

180000​

23​

5/16/2022​

Nguyễn Hồng Lĩnh

Nguyễn Trường Giang

20​

BTOP

Bali Top

chai

600000​

23​

5/16/2022​

Nguyễn Hồng Lĩnh

Nguyễn Trường Giang

20​

INDO

Indosuper

chai

1​

95000​

95000​

22​

5/16/2022​

Nguyễn Văn Giàu

Huỳnh Văn Thảo

5​

ECHSCL

Ếch sâu cuốn lá

gói

1​

300000​

300000​

22​

5/16/2022​

Nguyễn Văn Giàu

Huỳnh Văn Thảo

5​

VK

Vi khuẩn

gói

2​

43000​

86000​

22​

5/16/2022​

Nguyễn Văn Giàu

Huỳnh Văn Thảo

5​

CRR

Chuyên Ra rễ

chai

1​

95000​

95000​

21​

5/16/2022​

Nguyễn Văn Giàu

Nguyễn Văn Thàng

12​

PHC

Phân Hữu cơ - 40kg

bao

1​

399000​

399000​

20​

5/16/2022​

Nguyễn Văn Đúng

Ngô Văn Kết

12​

CRR

Chuyên Ra rễ

chai

1​

43000​

43000​

20​

5/16/2022​

Nguyễn Văn Đúng

Ngô Văn Kết

12​

PHC

Phân Hữu cơ - 40kg

bao

2​

399000​

798000​

20​

5/16/2022​

Nguyễn Văn Đúng

Ngô Văn Kết

12​

GUISER

Guiser - trộn

chai

1​

28000​

28000​

18​

5/15/2022​

Nguyễn Văn Giàu

Trương Văn Minh

20​

SAUDT

Sâu đục thân

gói

2​

22000​

44000​

16​

3​

95000​

285000​

15​

5/15/2022​

Trần Ngọc Quyên

0​

ECHSCL

Ếch sâu cuốn lá

gói

21​

38000​

798000​

14​

5/15/2022​

Trương Văn Huấn

21​

KTOP

Kona Top

chai

2​

90000​

180000​

14​

5/15/2022​

Trương Văn Huấn

21​

GOM18

Giống OM 18

kg

2​

220000​

440000​

13​

5/15/2022​

1/0/1900​

Dương Văn Yên

0​

VG

Vô gạo kona

gói

40​

23000​

920000​

13​

5/15/2022​

0​

Dương Văn Yên

0​

ĐON

Đạo ôn

gói

8​

305000​

2440000​

13​

5/15/2022​

0​

Dương Văn Yên

0​

VG

Vô gạo kona

gói

10​

65000​

650000​

13​

5/15/2022​

0​

Dương Văn Yên

0​

SAUDT

Sâu đục thân

gói

10​

34000​

340000​

 

[VetMini]

Lý do tại sao không dùng Pivot Table mà lại phải bắt chước phần mềm kế toán?

 

[SA_DQ]

@Tác gia bài đăng:
Tạo mới trang tính có tên là 'GPE' & cho chạy macro này:

Sub TongHopSanLuong()
 Dim Rws As Long, J As Long, Col As Integer, W As Integer, Tong As Double, Cot As Integer
 Dim Arr(), TenND As String
 
 Sheets("BTHBH").Select
 Rws = [E9999].End(xlUp).Row
 Col = [E3].CurrentRegion.Columns.Count
 Arr() = [A4].Resize(Rws, Col).Value
 ReDim aKQ(1 To 2 * Rws, 1 To Col)
 For J = 1 To Rws
    If TenND <> Arr(J, 5) Then
10 'Chép Tông    '
        W = W + 1
        aKQ(W, 5) = TenND:
        If Tong > 0 Then
            aKQ(W, 12) = Tong:                  Tong = 0
        End If
11 'Chép Dòng    '
        W = W + 1
        For Cot = 1 To Col
            aKQ(W, Cot) = Arr(J, Cot)
        Next Cot
        Tong = Arr(J, 12):                      TenND = Arr(J, 5)
    Else
20 ' Chép Dòng   '
        W = W + 1:                              Tong = Tong + Arr(J, 12)
        For Cot = 1 To Col
            aKQ(W, Cot) = Arr(J, Cot)
        Next Cot
    End If
 Next J
 Sheets("GPE").[A4].Resize(W, Col).Value = aKQ()
End Sub

 

[midi.mq]

Lý do tại sao không dùng Pivot Table mà lại phải bắt chước phần mềm kế toán?

em không chuyên nên không biết dùng nào cho ổn, bắt chước ở đây là cách để em nói cho m.n hiểu nhu cầu đang cần của em

Bài đã được tự động gộp: 31/5/22

@Tác gia bài đăng:
Tạo mới trang tính có tên là 'GPE' & cho chạy macro này:

Sub TongHopSanLuong()
 Dim Rws As Long, J As Long, Col As Integer, W As Integer, Tong As Double, Cot As Integer
 Dim Arr(), TenND As String
 
 Sheets("BTHBH").Select
 Rws = [E9999].End(xlUp).Row
 Col = [E3].CurrentRegion.Columns.Count
 Arr() = [A4].Resize(Rws, Col).Value
 ReDim aKQ(1 To 2 * Rws, 1 To Col)
 For J = 1 To Rws
    If TenND <> Arr(J, 5) Then
10 'Chép Tông    '
        W = W + 1
        aKQ(W, 5) = TenND:
        If Tong > 0 Then
            aKQ(W, 12) = Tong:                  Tong = 0
        End If
11 'Chép Dòng    '
        W = W + 1
        For Cot = 1 To Col
            aKQ(W, Cot) = Arr(J, Cot)
        Next Cot
        Tong = Arr(J, 12):                      TenND = Arr(J, 5)
    Else
20 ' Chép Dòng   '
        W = W + 1:                              Tong = Tong + Arr(J, 12)
        For Cot = 1 To Col
            aKQ(W, Cot) = Arr(J, Cot)
        Next Cot
    End If
 Next J
 Sheets("GPE").[A4].Resize(W, Col).Value = aKQ()
End Sub

Da, chạy không được ạ, xin chỉ thêm cho em ạ! mỗi lần chạy là hắn nhảy về BTHBH,

 

[SA_DQ]

Hắn nhảy về trang đó là do có dòng lệnh biểu hắn làm như thế;
Bạn thử thêm 1 dòng lệnh vô cuối macro, ngõ hầu kích hoạt trang 'GPE' xem sao(!)

 

[bebo021999]

Làm đại:

Option Explicit
Sub test()
Dim lr&, i&, j&, k&, rng, dic As Object, id As String, arr(), key
Set dic = CreateObject("Scripting.dictionary")
Worksheets("BTHBH").Activate
lr = Cells(Rows.Count, "A").End(xlUp).Row
Range("A4:O" & lr).Sort Range("A3"), , Range("E3")
On Error Resume Next
Range("E4:E" & lr).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
rng = Range("A4:O" & lr).Value
ReDim arr(1 To 65000, 1 To 15)
    For i = 1 To lr - 3
        id = rng(i, 1) & "|" & rng(i, 5)
        If Not dic.exists(id) Then
            dic.Add id, rng(i, 14)
        Else
            dic(id) = dic(id) + rng(i, 14)
        End If
    Next
    For i = 1 To lr - 3
        k = k + 1
        If i = 1 Then
            For j = 1 To 15
                arr(k, j) = rng(i, j)
            Next
        ElseIf rng(i, 5) = rng(i - 1, 5) Then
            For j = 1 To 15
                arr(k, j) = rng(i, j)
            Next
            Else
                arr(k, 5) = rng(i - 1, 5) & " - Total"
                For Each key In dic.keys
                    If rng(i - 1, 1) & "|" & rng(i - 1, 5) Like key Then arr(k, 14) = dic(key)
                Next
                    k = k + 1
                    For j = 1 To 15
                        arr(k, j) = rng(i, j)
                    Next
        End If
    Next
With Range("A4").Resize(k, 15)
    .Value = arr
    .Borders.LineStyle = xlContinuous
    .EntireColumn.AutoFit
End With
Range("A4:A" & k + 3).SpecialCells(xlCellTypeBlanks).EntireRow.Font.Bold = True
End Sub