Nhờ sửa VBA để tổng những mã trùng nhau (2 người xem)

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
T

thuanntk

Thành viên chính thức
Tham gia
14/1/10
Bài viết
81
Được thích
5
Nhờ anh chị diễn đàn sửa giúp mình VBA để sheet"DMKH" có những mã trùng thì bên sheet"TH_Congno" cộng lại ở số dư đầu kỳ giúp mình. ví dụ mã A001 trùng nhau thì bên sheet"TH_CN" số dư đầu kỳ là 520.000.000. Cảm ơn các A/C nhiều
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
Tôi tham gia bằng Code mới, 1 số vấn đề lưu ý:

Sheet TH congno xóa cột D ẩn đi vì chẳng để làm gì
Sheet DANH MUC được trùng mã KH vì thực chất đây là bảng số dư ngày mở file, 1 KH có thể có số dư trên nhiều TK
Đừng trông thấy Code nhiều mà đánh giá . Phải chạy test thử bằng dữ liệu nha.Mình cũng là dân kế toán nên cũng đụng rồi

Mã: 
Sub CongNo()
Dim Wf As Object, Cl As Collection
Dim Tng As Date, Dng As Date, Kq(), Tg(), Id, Tk, Sd, Tm1, Tm2, eR, i, j
ReDim Kq(1 To 1000, 1 To 9)
Set Dic = CreateObject("Scripting.Dictionary")
Set Wf = WorksheetFunction
Tng = CDate(Sheet6.[F5]): Dng = CDate(Sheet6.[H5]): Tk = Sheet6.[F4]
eR = Sheet1.[N65000].End(xlUp).Row - 2
'Tong hop cac KH co trong DM
Tm1 = Sheet8.Range("B3:H" & Sheet8.[B65000].End(xlUp).Row)
For i = 1 To UBound(Tm1, 1)
If Tm1(i, 5) = Tk Then
If Not Dic.exists(Tm1(i, 1)) Then
Id = Id + 1
Dic.Add Tm1(i, 1), Id
Kq(Id, 1) = Id
Kq(Id, 2) = Tm1(i, 1)
Kq(Id, 3) = Tm1(i, 2)
Sd = Tm1(i, 6) - Tm1(i, 7) + Wf.SumIfs(Sheet1.[N2].Resize(eR), Sheet1.[Q2].Resize(eR), Tm1(i, 1), _
Sheet1.[D2].Resize(eR), "<" & Tng, Sheet1.[J2].Resize(eR), Tk) - Wf.SumIfs(Sheet1.[N2].Resize(eR), _
Sheet1.[Q2].Resize(eR), Tm1(i, 1), Sheet1.[D2].Resize(eR), "<" & Tng, Sheet1.[K2].Resize(eR), Tk)
If Sd > 0 Then
Kq(Id, 4) = Sd: Kq(Id, 5) = 0
Else
Kq(Id, 4) = 0: Kq(Id, 5) = -1 * Sd
End If
Kq(Id, 6) = Wf.SumIfs(Sheet1.[N2].Resize(eR), Sheet1.[Q2].Resize(eR), Tm1(i, 1), _
Sheet1.[D2].Resize(eR), ">=" & Tng, Sheet1.[D2].Resize(eR), "<=" & Dng, Sheet1.[J2].Resize(eR), Tk)


Kq(Id, 7) = Wf.SumIfs(Sheet1.[N2].Resize(eR), Sheet1.[Q2].Resize(eR), Tm1(i, 1), _
Sheet1.[D2].Resize(eR), ">=" & Tng, Sheet1.[D2].Resize(eR), "<=" & Dng, Sheet1.[K2].Resize(eR), Tk)


If Kq(Id, 4) - Kq(Id, 5) + Kq(Id, 6) - Kq(Id, 7) > 0 Then
Kq(Id, 8) = Kq(Id, 4) - Kq(Id, 5) + Kq(Id, 6) - Kq(Id, 7): Kq(Id, 9) = 0
Else
Kq(Id, 8) = 0: Kq(Id, 9) = -1 * (Kq(Id, 4) - Kq(Id, 5) + Kq(Id, 6) - Kq(Id, 7))
End If
End If
End If
Next


'Soat KH khong co trong DM
Tm1 = Sheet1.[A2:R2].Resize(eR)
For i = 1 To UBound(Tm1, 1)
If Tm1(i, 10) = Tk And Not Dic.exists(Tm1(i, 17)) Then
Id = Id + 1
Dic.Add Tm1(i, 17), Id
Kq(Id, 1) = Id
Kq(Id, 2) = Tm1(i, 17)


Kq(Id, 4) = Wf.SumIfs(Sheet1.[N2].Resize(eR), Sheet1.[Q2].Resize(eR), Tm1(i, 17), _
Sheet1.[D2].Resize(eR), "<" & Tng, Sheet1.[J2].Resize(eR), Tk) - Wf.SumIfs(Sheet1.[N2].Resize(eR), _
Sheet1.[Q2].Resize(eR), Tm1(i, 17), Sheet1.[D2].Resize(eR), "<" & Tng, Sheet1.[K2].Resize(eR), Tk)


If Kq(Id, 4) < 0 Then
Kq(Id, 5) = -1 * Kq(Id, 4)
Kq(Id, 4) = 0
End If


Kq(Id, 6) = Wf.SumIfs(Sheet1.[N2].Resize(eR), Sheet1.[Q2].Resize(eR), Tm1(i, 17), _
Sheet1.[D2].Resize(eR), ">=" & Tng, Sheet1.[D2].Resize(eR), "<=" & Dng, Sheet1.[J2].Resize(eR), Tk)


Kq(Id, 7) = Wf.SumIfs(Sheet1.[N2].Resize(eR), Sheet1.[Q2].Resize(eR), Tm1(i, 17), _
Sheet1.[D2].Resize(eR), ">=" & Tng, Sheet1.[D2].Resize(eR), "<=" & Dng, Sheet1.[K2].Resize(eR), Tk)
Kq(Id, 8) = IIf(Kq(Id, 6) - Kq(Id, 7) > 0, Kq(Id, 6) - Kq(Id, 7), 0)
Kq(Id, 9) = IIf(Kq(Id, 7) - Kq(Id, 6) > 0, Kq(Id, 7) - Kq(Id, 6), 0)


ElseIf Tm1(i, 11) = Tk And Not Dic.exists(Tm1(i, 18)) Then
Id = Id + 1
Dic.Add Tm1(i, 18), Id
Kq(Id, 1) = Id
Kq(Id, 2) = Tm1(i, 18)
Kq(Id, 6) = Wf.SumIfs(Sheet1.[N2].Resize(eR), Sheet1.[Q2].Resize(eR), Tm1(i, 18), _
Sheet1.[D2].Resize(eR), ">=" & Tng, Sheet1.[D2].Resize(eR), "<=" & Dng, Sheet1.[J2].Resize(eR), Tk)


Kq(Id, 7) = Wf.SumIfs(Sheet1.[N2].Resize(eR), Sheet1.[Q2].Resize(eR), Tm1(i, 18), _
Sheet1.[D2].Resize(eR), ">=" & Tng, Sheet1.[D2].Resize(eR), "<=" & Dng, Sheet1.[K2].Resize(eR), Tk)
Kq(Id, 8) = IIf(Kq(Id, 4) - Kq(Id, 5) + Kq(Id, 6) - Kq(Id, 7) > 0, Kq(Id, 4) - Kq(Id, 5) + Kq(Id, 6) - Kq(Id, 7), 0)
Kq(Id, 9) = IIf(Kq(Kq(Id, 5) - Kq(Id, 4) + Id, 7) - Kq(Id, 6) > 0, Kq(Id, 5) - Kq(Id, 4) + Kq(Id, 7) - Kq(Id, 6), 0)


End If
Next
Sheet6.[A9:J1000].Clear
Sheet6.[A9].Resize(Id, 9) = Kq
Sheet7.[A10:I10].Copy
Sheet6.[A9].Resize(Id, 9).PasteSpecial xlPasteFormats
Sheet7.[A13:I13].Copy
Sheet6.Range("A" & 9 + Id & ":I" & 9 + Id).PasteSpecial xlPasteFormats
For i = 3 To 8
Sheet6.[A9].Offset(Id, i) = Wf.Sum(Sheet6.[A9].Offset(, i).Resize(Id))
Next
Thoat:
Set Wf = Nothing
Set Dic = Nothing


End Sub

P/s: Xin lỗi còn 1 số biến khai báo không dùng xóa đi giùm
 

File đính kèm

Upvote 0
comet_1701 đã viết:
Bài này chủ yếu vướng ở vấn đề bạn nói ở trên thì tạm thời làm thế này đi, đợi người phù hợp qua giúp.
Tạo thêm một sub phụ nữa, chạy sub này trước, rồi chạy sub TH_CN
Nhấp chuột vào đây để mở rộng...
Không đơn giản là chỉ có mã khách hàng trùng đâu, theo mình hiểu là trùng cả mã tài khoản nữa.
Tác giả đưa điều kiện theo kiểu "nhát gừng" nên mình bó tay.
 
Upvote 0
chucuoi92 đã viết:
Không đơn giản là chỉ có mã khách hàng trùng đâu, theo mình hiểu là trùng cả mã tài khoản nữa.
Tác giả đưa điều kiện theo kiểu "nhát gừng" nên mình bó tay.
Nhấp chuột vào đây để mở rộng...

Theo mình mình chỉ tham gia theo cái lệ chung thôi, còn riêng tư thì phải có ý kiến.
Thực chất Code của mình bắt đầu từ đoạn soat KH không co trong DM là đoạn khá lớn chỉ đề phòng người ta thêm KH ngang không kê khai DM. Nếu chỉ soát theo Danh muc thì đơn giản rất nhiều,
 
Lần chỉnh sửa cuối:
Upvote 0
sealand đã viết:
Tôi tham gia bằng Code mới, 1 số vấn đề lưu ý:

Sheet TH congno xóa cột D ẩn đi vì chẳng để làm gì
Sheet DANH MUC được trùng mã KH vì thực chất đây là bảng số dư ngày mở file, 1 KH có thể có số dư trên nhiều TK
Đừng trông thấy Code nhiều mà đánh giá . Phải chạy test thử bằng dữ liệu nha.Mình cũng là dân kế toán nên cũng đụng rồi

Mã: 
Sub CongNo()
Dim Wf As Object, Cl As Collection
Dim Tng As Date, Dng As Date, Kq(), Tg(), Id, Tk, Sd, Tm1, Tm2, eR, i, j
ReDim Kq(1 To 1000, 1 To 9)
Set Dic = CreateObject("Scripting.Dictionary")
Set Wf = WorksheetFunction
Tng = CDate(Sheet6.[F5]): Dng = CDate(Sheet6.[H5]): Tk = Sheet6.[F4]
eR = Sheet1.[N65000].End(xlUp).Row - 2
'Tong hop cac KH co trong DM
Tm1 = Sheet8.Range("B3:H" & Sheet8.[B65000].End(xlUp).Row)
For i = 1 To UBound(Tm1, 1)
If Tm1(i, 5) = Tk Then
If Not Dic.exists(Tm1(i, 1)) Then
Id = Id + 1
Dic.Add Tm1(i, 1), Id
Kq(Id, 1) = Id
Kq(Id, 2) = Tm1(i, 1)
Kq(Id, 3) = Tm1(i, 2)
Sd = Tm1(i, 6) - Tm1(i, 7) + Wf.SumIfs(Sheet1.[N2].Resize(eR), Sheet1.[Q2].Resize(eR), Tm1(i, 1), _
Sheet1.[D2].Resize(eR), "<" & Tng, Sheet1.[J2].Resize(eR), Tk) - Wf.SumIfs(Sheet1.[N2].Resize(eR), _
Sheet1.[Q2].Resize(eR), Tm1(i, 1), Sheet1.[D2].Resize(eR), "<" & Tng, Sheet1.[K2].Resize(eR), Tk)
If Sd > 0 Then
Kq(Id, 4) = Sd: Kq(Id, 5) = 0
Else
Kq(Id, 4) = 0: Kq(Id, 5) = -1 * Sd
End If
Kq(Id, 6) = Wf.SumIfs(Sheet1.[N2].Resize(eR), Sheet1.[Q2].Resize(eR), Tm1(i, 1), _
Sheet1.[D2].Resize(eR), ">=" & Tng, Sheet1.[D2].Resize(eR), "<=" & Dng, Sheet1.[J2].Resize(eR), Tk)


Kq(Id, 7) = Wf.SumIfs(Sheet1.[N2].Resize(eR), Sheet1.[Q2].Resize(eR), Tm1(i, 1), _
Sheet1.[D2].Resize(eR), ">=" & Tng, Sheet1.[D2].Resize(eR), "<=" & Dng, Sheet1.[K2].Resize(eR), Tk)


If Kq(Id, 4) - Kq(Id, 5) + Kq(Id, 6) - Kq(Id, 7) > 0 Then
Kq(Id, 8) = Kq(Id, 4) - Kq(Id, 5) + Kq(Id, 6) - Kq(Id, 7): Kq(Id, 9) = 0
Else
Kq(Id, 8) = 0: Kq(Id, 9) = -1 * (Kq(Id, 4) - Kq(Id, 5) + Kq(Id, 6) - Kq(Id, 7))
End If
End If
End If
Next


'Soat KH khong co trong DM
Tm1 = Sheet1.[A2:R2].Resize(eR)
For i = 1 To UBound(Tm1, 1)
If Tm1(i, 10) = Tk And Not Dic.exists(Tm1(i, 17)) Then
Id = Id + 1
Dic.Add Tm1(i, 17), Id
Kq(Id, 1) = Id
Kq(Id, 2) = Tm1(i, 17)


Kq(Id, 4) = Wf.SumIfs(Sheet1.[N2].Resize(eR), Sheet1.[Q2].Resize(eR), Tm1(i, 17), _
Sheet1.[D2].Resize(eR), "<" & Tng, Sheet1.[J2].Resize(eR), Tk) - Wf.SumIfs(Sheet1.[N2].Resize(eR), _
Sheet1.[Q2].Resize(eR), Tm1(i, 17), Sheet1.[D2].Resize(eR), "<" & Tng, Sheet1.[K2].Resize(eR), Tk)


If Kq(Id, 4) < 0 Then
Kq(Id, 5) = -1 * Kq(Id, 4)
Kq(Id, 4) = 0
End If


Kq(Id, 6) = Wf.SumIfs(Sheet1.[N2].Resize(eR), Sheet1.[Q2].Resize(eR), Tm1(i, 17), _
Sheet1.[D2].Resize(eR), ">=" & Tng, Sheet1.[D2].Resize(eR), "<=" & Dng, Sheet1.[J2].Resize(eR), Tk)


Kq(Id, 7) = Wf.SumIfs(Sheet1.[N2].Resize(eR), Sheet1.[Q2].Resize(eR), Tm1(i, 17), _
Sheet1.[D2].Resize(eR), ">=" & Tng, Sheet1.[D2].Resize(eR), "<=" & Dng, Sheet1.[K2].Resize(eR), Tk)
Kq(Id, 8) = IIf(Kq(Id, 6) - Kq(Id, 7) > 0, Kq(Id, 6) - Kq(Id, 7), 0)
Kq(Id, 9) = IIf(Kq(Id, 7) - Kq(Id, 6) > 0, Kq(Id, 7) - Kq(Id, 6), 0)


ElseIf Tm1(i, 11) = Tk And Not Dic.exists(Tm1(i, 18)) Then
Id = Id + 1
Dic.Add Tm1(i, 18), Id
Kq(Id, 1) = Id
Kq(Id, 2) = Tm1(i, 18)
Kq(Id, 6) = Wf.SumIfs(Sheet1.[N2].Resize(eR), Sheet1.[Q2].Resize(eR), Tm1(i, 18), _
Sheet1.[D2].Resize(eR), ">=" & Tng, Sheet1.[D2].Resize(eR), "<=" & Dng, Sheet1.[J2].Resize(eR), Tk)


Kq(Id, 7) = Wf.SumIfs(Sheet1.[N2].Resize(eR), Sheet1.[Q2].Resize(eR), Tm1(i, 18), _
Sheet1.[D2].Resize(eR), ">=" & Tng, Sheet1.[D2].Resize(eR), "<=" & Dng, Sheet1.[K2].Resize(eR), Tk)
Kq(Id, 8) = IIf(Kq(Id, 4) - Kq(Id, 5) + Kq(Id, 6) - Kq(Id, 7) > 0, Kq(Id, 4) - Kq(Id, 5) + Kq(Id, 6) - Kq(Id, 7), 0)
Kq(Id, 9) = IIf(Kq(Kq(Id, 5) - Kq(Id, 4) + Id, 7) - Kq(Id, 6) > 0, Kq(Id, 5) - Kq(Id, 4) + Kq(Id, 7) - Kq(Id, 6), 0)


End If
Next
Sheet6.[A9:J1000].Clear
Sheet6.[A9].Resize(Id, 9) = Kq
Sheet7.[A10:I10].Copy
Sheet6.[A9].Resize(Id, 9).PasteSpecial xlPasteFormats
Sheet7.[A13:I13].Copy
Sheet6.Range("A" & 9 + Id & ":I" & 9 + Id).PasteSpecial xlPasteFormats
For i = 3 To 8
Sheet6.[A9].Offset(Id, i) = Wf.Sum(Sheet6.[A9].Offset(, i).Resize(Id))
Next
Thoat:
Set Wf = Nothing
Set Dic = Nothing


End Sub

P/s: Xin lỗi còn 1 số biến khai báo không dùng xóa đi giùm
Nhấp chuột vào đây để mở rộng...
http://www.giaiphapexcel.com/forum/...NXT-với-tốc-độ-nhanh-nhất-dữ-liệu-65-532-dòng
Anh Việt dùng Dictionary va Collection chắc tốc độ ok, anh rảnh thì vào đây ngó coi, kết quả bài 175 anh nhé
 
Upvote 0
sealand đã viết:
Theo mình mình chỉ tham gia theo cái lệ chung thôi, còn riêng tư thì phải có ý kiến.
Thực chất Code của mình bắt đầu từ đoạn soat KH không co trong DM là đoạn khá lớn chỉ đề phòng người ta thêm KH ngang không kê khai DM. Nếu chỉ soát theo Danh muc thì đơn giản rất nhiều,
Nhấp chuột vào đây để mở rộng...

Em có phải dân KT đâu, tác giả nói sao thì làm vậy thôi,code viết lâu rồi nên xem lại cũng không hiểu mình viết thế nào nữa. có cài gì là riêng tư ở đây đâu anh!
 
Upvote 0
comet_1701 đã viết:
http://www.giaiphapexcel.com/forum/...NXT-với-tốc-độ-nhanh-nhất-dữ-liệu-65-532-dòng
Anh Việt dùng Dictionary va Collection chắc tốc độ ok, anh rảnh thì vào đây ngó coi, kết quả bài 175 anh nhé
Nhấp chuột vào đây để mở rộng...

Mình không chủ quan, nhưng mình khá yên tâm với code này, nó chỉ dùng Dic thôi còn Collection lúc đầu định dùng nhưng phải bấy lỗi nên thôi. Trước đây mình dùng Ex 2003 nên cũng dùng cách như anh chucuoi nhưng giờ mình dùng luôn hàm sumifs cho nó khỏe, khỏi phải rà lại hết cái mảng phát sinh (Thường là khá lớn). Các file của mình viết cách này dữ liệu khá nhiều nhưng cứ chọn điệu kiện xong là OK


To Chucuoi92: Ấy là mình nói tác giả thích khác lệ thường thì phải nêu ra đấy chứ.
 
Lần chỉnh sửa cuối:
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

PhanTuHuong
Nên chọn điện thoại nào? (1 người xem)
2
Trả lời
20
Đọc
1K
dungluyen2119
dungluyen2119
PhanTuHuong
Hà Nội hẹn hò gặp gỡ đầu năm 2025 thôi :)
    • Thích
    • Yêu thích
Trả lời
9
Đọc
385
Nguyễn Duy Tuân
Nguyễn Duy Tuân
Manhhung90
Tạo nút bấm để xoá nhanh trang trong file word.
Trả lời
3
Đọc
77
PhanTuHuong
PhanTuHuong
H
Hàm Evaluate bị lỗi khi mở lại (1 người xem)
2
Trả lời
23
Đọc
276
ptm0412
ptm0412
T
tìm ra số tháng mà lượng hàng nhập ban đầu sử dụng hết
    • Buồn
    • Cười
Trả lời
5
Đọc
210
SA_DQ
SA_DQ
Nguyễn Duy Tuân
Lập trình VBA với Google Drive, OneDrive, DropBox cho Upload-Download-Copy-Move...
    • Cảm ơn
    • Thích
Trả lời
4
Đọc
297
quyenpv
quyenpv
hungmanh.th1
Lỗi không trả về Giá trị 0 trong excel (1 người xem)
    • Cười
Trả lời
5
Đọc
63
hungmanh.th1
hungmanh.th1
HeSanbi
  • Question Question
VBA nâng cao: Nhúng tập tin vào trang tính hoặc trích xuất chúng nhanh chóng (2 người xem)
    • Thích
    • Cảm ơn
Trả lời
0
Đọc
117
HeSanbi
HeSanbi
nguyễn tiến tú
file CALCULATING rất chậm em nhờ các anh chị xem giúp em ạ
Trả lời
7
Đọc
370
tranhungdao12a3
T
T
  • Question Question
Xin thầy/cô và anh chị giúp đỡ cách điền thông tin ca kíp trực trong bảng Excel bằng VBA
Trả lời
2
Đọc
146
tiennd67
T
vnxgiokinhtoi
Nhờ giúp đỡ công thức lưu dữ liệu và mở lại dữ liệu cũ đã save (1 người xem)
Trả lời
2
Đọc
103
le_vis
L
H
HELP! HÀM LẤY THÁNG/ NĂM TRONG EXCEL
Trả lời
5
Đọc
127
ptm0412
ptm0412
H
Em hỏi vì sao khi file googlesheet của em thì code chạy
Trả lời
2
Đọc
56
Hoale85
H
4
EXCEL TỰ ĐỘNG MỞ TRÊN WEB
Trả lời
9
Đọc
268
4545
4
T
Nhờ ACE chỉ giáo công thức Gộp nhiều dữ liệu vào một ô trong excel
Trả lời
9
Đọc
228
Hoàng Tuấn 868
H
H
Phân quyền xem trên từng trang tính của googlesheet
Trả lời
6
Đọc
146
tranhungdao12a3
T
vn81206
TRA CỨU MÃ SỐ THUẾ CÁ NHÂN QUA EXCEL (3 người xem)
    • Buồn
2 3
Trả lời
50
Đọc
14K
HeSanbi
HeSanbi
GPE-Trợ Lý
CHÚC MỪNG NGÀY QUỐC TẾ PHỤ NỮ 08/03/2025
    • Yêu thích
    • Thích
Trả lời
0
Đọc
55
GPE-Trợ Lý
GPE-Trợ Lý
M
  • Question Question
Tự chèn dòng khi cập nhật dữ liệu từ trang tính khác.
Trả lời
6
Đọc
282
hoangtuan.net
hoangtuan.net
K
Không đăng nhập được MS Teams sau khi tải về (chỉ cho sử dụng bản trên web)
Trả lời
4
Đọc
116
ptm0412
ptm0412
Xem thêm…

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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom