Cộng dồn hóa đơn thanh toán (1 người xem)

toandiennuoc123 · 10/11/15

Chào các bạn ! Tôi có 1 file trong đó có rất nhiều hóa đơn được tổng hợp lại, tên của sản phẩm thì giống nhau nhưng số lượng thì khác nay tôi muốn cột số lượng tự động cộng lại với nhau của cùng 1 tên sản phẩm. Mời các bạn xem file đính kèm sẽ rõ hơn. Xin chân thành cám ơn các bạn.

giaiphap · 10/11/15

toandiennuoc123 đã viết:
Chào các bạn ! Tôi có 1 file trong đó có rất nhiều hóa đơn được tổng hợp lại, tên của sản phẩm thì giống nhau nhưng số lượng thì khác nay tôi muốn cột số lượng tự động cộng lại với nhau của cùng 1 tên sản phẩm. Mời các bạn xem file đính kèm sẽ rõ hơn. Xin chân thành cám ơn các bạn.

Hy vọng đúng ý bạn, hên xui nghe! File 2 mới hoàn chỉnh

toandiennuoc123 · 10/11/15

Bạn chưa cộng cột số lượng rồi.

giaiphap · 10/11/15

toandiennuoc123 đã viết:
Bạn chưa cộng cột số lượng rồi.

Đã sửa lại hoàn chỉnh ở file 2

doatmenhhon · 10/11/15

Mã:

Sub Tong()  
Dim Dic, Sarr
 Dim i, j As Long, k As Long
Sarr = Range([B5], [B65000].End(xlUp)).Resize(, 5)
Set Dic = CreateObject("Scripting.Dictionary")
ReDim dArr(1 To UBound(Sarr), 1 To 6)
  For i = 1 To UBound(Sarr)
      Tmp = Sarr(i, 1)
        With Dic
            If Not .Exists(Tmp) Then
                k = k + 1
                .Add Tmp, k
             dArr(k, 1) = k
            For j = 1 To 5
                dArr(k, j + 1) = Sarr(i, j)
            Next j
         Else
             dArr(.Item(Tmp), 6) = dArr(.Item(Tmp), 6) + Sarr(i, 5)
         End If
    End With
  Next i
  [H5:M65000].ClearContents
  [H5].Resize(k, 6).Value = dArr
  Set Dic = Nothing
  End Sub

Sửa của Giải Pháp một tí. Còn sửa cộng khối lượng. Hi

giaiphap · 10/11/15

doatmenhhon đã viết:

Mã:

Sub Tong()  
Dim Dic, Sarr
 Dim i, j As Long, k As Long
Sarr = Range([B5], [B65000].End(xlUp)).Resize(, 5)
Set Dic = CreateObject("Scripting.Dictionary")
ReDim dArr(1 To UBound(Sarr), 1 To 6)
  For i = 1 To UBound(Sarr)
      Tmp = Sarr(i, 1)
        With Dic
            If Not .Exists(Tmp) Then
                k = k + 1
                .Add Tmp, k
             dArr(k, 1) = k
            For j = 1 To 5
                dArr(k, j + 1) = Sarr(i, j)
            Next j
         Else
             dArr(.Item(Tmp), 6) = dArr(.Item(Tmp), 6) + Sarr(i, 5)
         End If
    End With
  Next i
  [H5:M65000].ClearContents
  [H5].Resize(k, 6).Value = dArr
  Set Dic = Nothing
  End Sub

Sửa của Giải Pháp một tí. Còn sửa cộng khối lượng. Hi

Nếu code này thì sửa lại chút vầy mới đúng

Mã:

Sub Tong()
Dim Dic, Sarr
  Dim i, j As Long, k As Long
Sarr = Range([B5], [B65000].End(xlUp)).Resize(, 5)
Set Dic = CreateObject("Scripting.Dictionary")
ReDim dArr(1 To UBound(Sarr), 1 To 6)
  For i = 1 To UBound(Sarr)
      Tmp = Sarr(i, 1)
        With Dic
            If Not .Exists(Tmp) Then
                k = k + 1
                .Add Tmp, k
             dArr(k, 1) = k
            For j = 1 To 5
                dArr(k, j + 1) = Sarr(i, j)
            Next j
         Else
             dArr(.Item(Tmp), 6) = dArr(.Item(Tmp), 6) + Sarr(i, 5)
             dArr(.Item(Tmp), 4) = dArr(.Item(Tmp), 4) + CInt(Sarr(i, 3))
         End If
    End With
  Next i
  [H5:M65000].ClearContents
  [H5].Resize(k, 6).Value = dArr
  Set Dic = Nothing
  End Sub

khuongvietphong · 10/11/15

Cho mình hỏi trong File bạn chủ thớt gửi có nút cộng dồn (màu xanh ý) , tại sao khi viết sub xong mình muốn gán sub đó cho cái nút xanh xanh ấy mà không gán được nhỉ, tức là bấm phải chuột vào nút đó để gán Sub chạy mà không có được , và nếu muốn xóa cái nút đó đi cũng ko xóa được là sao nhỉ...

doatmenhhon · 10/11/15

giaiphap đã viết:

Nếu code này thì sửa lại chút vầy mới đúng

Mã:

Sub Tong()
Dim Dic, Sarr
  Dim i, j As Long, k As Long
Sarr = Range([B5], [B65000].End(xlUp)).Resize(, 5)
Set Dic = CreateObject("Scripting.Dictionary")
ReDim dArr(1 To UBound(Sarr), 1 To 6)
  For i = 1 To UBound(Sarr)
      Tmp = Sarr(i, 1)
        With Dic
            If Not .Exists(Tmp) Then
                k = k + 1
                .Add Tmp, k
             dArr(k, 1) = k
            For j = 1 To 5
                dArr(k, j + 1) = Sarr(i, j)
            Next j
         Else
             dArr(.Item(Tmp), 6) = dArr(.Item(Tmp), 6) + Sarr(i, 5)
             dArr(.Item(Tmp), 4) = dArr(.Item(Tmp), 4) + CInt(Sarr(i, 3))
         End If
    End With
  Next i
  [H5:M65000].ClearContents
  [H5].Resize(k, 6).Value = dArr
  Set Dic = Nothing
  End Sub

Ừa làm xong mới để ý thấy, sửa mà chạy ổn là ok. Ha ha

giaiphap · 10/11/15

khuongvietphong đã viết:
Cho mình hỏi trong File bạn chủ thớt gửi có nút cộng dồn (màu xanh ý) , tại sao khi viết sub xong mình muốn gán sub đó cho cái nút xanh xanh ấy mà không gán được nhỉ, tức là bấm phải chuột vào nút đó để gán Sub chạy mà không có được , và nếu muốn xóa cái nút đó đi cũng ko xóa được là sao nhỉ...

Bạn ấy tạo nút bằng Activex Control nên không nhấp phải vào nút đó được, mà đáng lý ra chúng ta phải tạo nút ở nhóm Form Controls.

Để chọn nút đó và xóa thì ta bật nút lệnh Design Model sau đó nháy chọn nút và xóa bình thường.

gtri · 10/11/15

toandiennuoc123 đã viết:
Chào các bạn ! Tôi có 1 file trong đó có rất nhiều hóa đơn được tổng hợp lại, tên của sản phẩm thì giống nhau nhưng số lượng thì khác nay tôi muốn cột số lượng tự động cộng lại với nhau của cùng 1 tên sản phẩm. Mời các bạn xem file đính kèm sẽ rõ hơn. Xin chân thành cám ơn các bạn.

Góp đoạn code

Mã:

Public Sub CongDon()
Dim DL, r As Long, c As Long, i

DL = Sheet1.Range("A5:F22")
i = 1

For r = 2 To UBound(DL)
If DL(r, 2) = DL(i, 2) Then
For c = 1 To UBound(DL, 2)
If c > 3 Then DL(i, c) = DL(i, c) + DL(r, c)
DL(r, c) = ""
Next c
Else
i = r
End If
Next r

Sheet1.Range("H5:M22").ClearContents
Sheet1.Range("H5:M22") = DL
End Sub

doatmenhhon · 10/11/15

khuongvietphong đã viết:
Cho mình hỏi trong File bạn chủ thớt gửi có nút cộng dồn (màu xanh ý) , tại sao khi viết sub xong mình muốn gán sub đó cho cái nút xanh xanh ấy mà không gán được nhỉ, tức là bấm phải chuột vào nút đó để gán Sub chạy mà không có được , và nếu muốn xóa cái nút đó đi cũng ko xóa được là sao nhỉ...

Mình để ý thấy các nút Command Button hình như không xóa được ý ^^

khuongvietphong · 10/11/15

giaiphap đã viết:
Bạn ấy tạo nút bằng Activex Control nên không nhấp phải vào nút đó được, mà đáng lý ra chúng ta phải tạo nút ở nhóm Form Controls.
View attachment 150366
Để chọn nút đó và xóa thì ta bật nút lệnh Design Model sau đó nháy chọn nút và xóa bình thường.

Em làm theo và đã xóa được nó rồi ạ, xin hỏi thêm tác giả là tại sao cái Button trong Form Controls với cái Command Button trong Activex Control khác nhau như thế nào mà tại sao 1 cái có thể gắn Sub vào còn cái kia thì không ạ. Tổng quát hơn thì giữa 2 cái Form Controls với cái Activex Control có gì khác nhau ạ. Em xin cảm ơn !

khuongvietphong · 10/11/15

doatmenhhon đã viết:
Mình để ý thấy các nút Command Button hình như không xóa được ý ^^

Bạn làm theo tác giả Giaiphap nói bên trên là xóa được đó

giaiphap · 10/11/15

khuongvietphong đã viết:
Em làm theo và đã xóa được nó rồi ạ, xin hỏi thêm tác giả là tại sao cái Button trong Form Controls với cái Command Button trong Activex Control khác nhau như thế nào mà tại sao 1 cái có thể gắn Sub vào còn cái kia thì không ạ. Tổng quát hơn thì giữa 2 cái Form Controls với cái Activex Control có gì khác nhau ạ. Em xin cảm ơn !

Cái khác thì mình chưa rành lắm, còn việc gắn Sub thì vẫn được mà bạn, cả 2 đều gắn được Sub hết có điều Activex Control thì sub đặt trong sheet, con Form Controls thì đặt trong Module.

doatmenhhon · 10/11/15

hpkhuong đã viết:
Hình như code này chưa ổn phải hok nhỉ?

Hihi còn chiêu xóa luôn cả hàng cứ bị bạn "phê bình" định lấy ra biểu diễn nốt nhưng thấy bạn lại thôi.

doatmenhhon · 10/11/15

khuongvietphong đã viết:
Bạn làm theo tác giả Giaiphap nói bên trên là xóa được đó

Ờ giờ tớ mới biết đấy

khuongvietphong · 10/11/15

giaiphap đã viết:
Cái khác thì mình chưa rành lắm, còn việc gắn Sub thì vẫn được mà bạn, cả 2 đều gắn được Sub hết có điều Activex Control thì sub đặt trong sheet, con Form Controls thì đặt trong Module.

Đoạn gạch chân không đúng, trong sheet rõ ràng có code mà khi tạo Command Button từ Activex Control sau đo phải chuột để gán sub nhưng đâu có thấy chổ nào để gán đâu

doatmenhhon · 10/11/15

khuongvietphong đã viết:
Đoạn gạch chân không đúng, trong sheet rõ ràng có code mà khi tạo Command Button từ Activex Control sau đo phải chuột để gán sub nhưng đâu có thấy chổ nào để gán đâu

View attachment 150367

Có cái view code mà bạn

giaiphap · 10/11/15

khuongvietphong đã viết:
Đoạn gạch chân không đúng, trong sheet rõ ràng có code mà khi tạo Command Button từ Activex Control sau đo phải chuột để gán sub nhưng đâu có thấy chổ nào để gán đâu

View attachment 150367

Bạn vào cửa sổ VBE (Alt+F11) và thực hiện như hình.

gtri · 10/11/15

hpkhuong đã viết:
Hình như code này chưa ổn phải hok nhỉ?

Nhìn qua nên không để ý đơn giá phải giữ nguyên
Sửa thế này chắc được

Mã:

If c > 3 Then DL(i, c) = DL(i, c) + DL(r, c)
thành
If c > 3 And c <> 5 Then DL(i, c) = DL(i, c) + DL(r, c)

Cộng dồn hóa đơn thanh toán (1 người xem)

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

Thành viên thường trực

File đính kèm

==(^o^)==

File đính kèm

Thành viên thường trực

==(^o^)==

Thành viên tiêu biểu

==(^o^)==

Be all you can be !

Thành viên tiêu biểu

==(^o^)==

Thành viên tích cực

Thành viên tiêu biểu

Be all you can be !

Be all you can be !

==(^o^)==

Thành viên tiêu biểu

Thành viên tiêu biểu

Be all you can be !

Thành viên tiêu biểu

==(^o^)==

Thành viên tích cực

Đếm ngược thời gian