Xin được hướng dẫn hoàn thiện code lọc và cộng dồn (1 người xem)

[vndat]

Em có đoạn code sau:
Sub CopyDuAn()
With Sheets("CHUNGTU").Range("A1").CurrentRegion
.AutoFilter 9, Sheets("Welcome").[G4]
.Offset(1, 0).SpecialCells(12).Copy
Sheets("TonghopDuAn").Range("H6").PasteSpecial 3
.AutoFilter
End With
End Sub
tuy nhiên em muốn sau khi lọc xong thì cộng dồn các hàng có cùng mã với cột (H) chẵng hạn trước khi copy qua một sheet khác.

 

[phucbugis]

Em có đoạn code sau:
Sub CopyDuAn()
With Sheets("CHUNGTU").Range("A1").CurrentRegion
.AutoFilter 9, Sheets("Welcome").[G4]
.Offset(1, 0).SpecialCells(12).Copy
Sheets("TonghopDuAn").Range("H6").PasteSpecial 3
.AutoFilter
End With
End Sub
tuy nhiên em muốn sau khi lọc xong thì cộng dồn các hàng có cùng mã với cột (H) chẵng hạn trước khi copy qua một sheet khác.

bạn up cái file đó lên GPE đi (+ nói rõ yêu cầu hơn 1 tí nữa), để mọi người chỉnh sửa + test lại nữa chứ ! (xem code vậy khó hình dung)

 

[vndat]

Cảm ơn bạn! đây là sheet và yêu cầu đính kèm

 

[phucbugis]

Cảm ơn bạn! đây là sheet và yêu cầu đính kèm

- file bạn gửi file đó so với code của #1 ---> chẳng liên quan gì với nhau cả ,

- bạn tải lại file đính kèm, với điều kiện lọc ở sheet 1 như vậy thì kết quả ở sheet này bạn muốn nó thể hiện ra như thế nào?

Link: https://www.mediafire.com/?412p366vrmpmg2m

 

[vndat]

Em xin gửi lại đầy đủ đây kèm theo đạon code sau
Sub CopyDuAn()
With Sheets("CHUNGTU").Range("A1").CurrentRegion
.AutoFilter 9, Sheets("Welcome").[G4]
.Offset(1, 0).SpecialCells(12).Copy
Sheets("TonghopDuAn").Range("H6").PasteSpecial 3
.AutoFilter
End With
End Sub
_______________________________________________
Sub BaoCaoTheoDuAn()
Call CopyDuAn
n = Sheets("TonghopDuAn").Range("H65000").End(xlUp).Row
Sheets("TonghopDuAn").Range("A6:F" & n + 10).Clear 'chon co 10 goi thau
Sheets("TonghopDuAn").Range("A6:F" & n + 10).Font.Name = "Times New Roman"
For i = 6 To n
Sheets("TonghopDuAn").Cells(i, 1) = Sheets("TonghopDuAn").Cells(i, 10)
Sheets("TonghopDuAn").Cells(i, 2) = Sheets("TonghopDuAn").Cells(i, 12)
Sheets("TonghopDuAn").Cells(i, 3) = Sheets("TonghopDuAn").Cells(i, 11)
Sheets("TonghopDuAn").Cells(i, 4) = Sheets("TonghopDuAn").Cells(i, 15)
Sheets("TonghopDuAn").Cells(i, 5) = Sheets("TonghopDuAn").Cells(i, 13)
Sheets("TonghopDuAn").Cells(i, 6) = Application.WorksheetFunction.SumIf(Sheets("CHUNGTU").Range("C2:C2000"), Sheets("TonghopDuAn").Range("A" & i), Sheets("CHUNGTU").Range("L2:L2000"))
Next
Range("A1").Select
End Sub

 

[phucbugis]

Em xin gửi lại đầy đủ đây kèm theo đạon code sau
...

bạn tải đính kèm, cho chạy Macro.

vào sheet TonghopDuAn -> điền mã dự án tại ô B2 --> click Button 1 --> xem kết quả .

Link: https://www.mediafire.com/?cp0e42jdatfxx1r

 

[vndat]

Cảm ơn bác! tuy nhiên em muốn mảng mang qua sheet TonghopDuAn với mã hợp đồng giống nhau thì cộng dồn thành 1hang như sau theo file đính kèm,
Theo em hiểu mình có thể sử dụng sheet trung gian hay không hay là mình không dùng fiter là dùng hàm khác? có được không bác
còn phần tổng cộng, boder. . . em đã có code riêng nhưng không đưa vào

 

[vndat]

em thấy code của bác ndu96081631 trên GEP thấy có gì đó có thể áp dụng được nhưng biết cách tùy biến như thế nào
Sub Main()
Dim MN As String, SP As String, CN As String, QT As String, AM As String
With ThisWorkbook.Sheets("Data")
.Range("M:V").Clear
With .Range("A1").CurrentRegion
With Intersect(.Cells, .Offset(1, 2)).Resize(, 1)
MN = .Offset(, 0).Address(, , 2)
SP = .Offset(, 1).Address(, , 2)
CN = .Offset(, 2).Address(, , 2)
QT = .Offset(, 3).Address(, , 2)
AM = .Offset(, 6).Address(, , 2)
End With
.Offset(, 2).Resize(, 3).AdvancedFilter 1, , , True
.SpecialCells(12).Copy Range("M1")
.Parent.ShowAllData
End With
With .Range("M1").CurrentRegion
With Intersect(.Cells, .Offset(1, 5)).Resize(, 1)
.Offset(, 0).Value = "=SUMPRODUCT((" & MN & "=RC[-3])*(" & SP & "=RC[-2])*(" & CN & "=RC[-1])*(" & QT & "))"
.Offset(, 3).Value = "=SUMPRODUCT((" & MN & "=RC[-6])*(" & SP & "=RC[-5])*(" & CN & "=RC[-4])*(" & AM & "))"
End With
.Value = .Value
End With
.Range("M:V").EntireColumn.AutoFit
End With
End Sub
mong được sự chỉ giáo

 

[Ba Tê]

Cảm ơn bác! tuy nhiên em muốn mảng mang qua sheet TonghopDuAn với mã hợp đồng giống nhau thì cộng dồn thành 1hang như sau theo file đính kèm,
Theo em hiểu mình có thể sử dụng sheet trung gian hay không hay là mình không dùng fiter là dùng hàm khác? có được không bác
còn phần tổng cộng, boder. . . em đã có code riêng nhưng không đưa vào

Bạn cứ đưa cái "CODE" gì đó hoài, chẳng ai thèm đọc xem nó muốn làm cái gì đâu.
Thà bạn đưa cái kết quả bạn muốn có lên từ đầu thì đâu dài dòng đến vậy.
Xem thử file này, còn phần tổng cộng ... bên dưới bạn nói có code riêng thì bạn tự thêm vào nhé.

 

[vndat]

Cảm ơn Ba Tê! Mình là dân amautur nên tập tành viết chương file quản lý dự án trước là để phục vụ cho bản thân sau là biết thêm nhiều điều; mong bạn chỉ giáo.
thật thì mình là dân cầu đường và mình có đọc cách sử dụng Dictionary ở mấy mục trên nhưng vẫn chưa hiều gì nay càng không hiểu. mình sẽ tiếp tục nghiên cứu nếu cái gì không rõ ở code bạn đã giúp mong bạn hướng dẫn hộ.
chân thành cảm ơn

 

[vndat]

Có cách nào không phải dùng Dictionary không bạn Pa Tê or quanghai vì nếu Pa tê viết thế thì hợp đồng và giá trị thanh toán tăng theo số lần xuiất hiện rồi vì kết quả mình cần là giá trị hợ đồng không đổi, giá trị thanh toán cộng dồn. gửi bạn.

 

[vndat]

Có cách nào không phải dùng Dictionary không bạn Pa Tê or quanghai vì nếu Pa tê viết thế thì hợp đồng và giá trị thanh toán tăng theo số lần xuiất hiện rồi vì kết quả mình cần là giá trị hợ đồng không đổi, giá trị thanh toán cộng dồn. gửi bạn.

 

[Ba Tê]

Có cách nào không phải dùng Dictionary không bạn Pa Tê or quanghai vì nếu Pa tê viết thế thì hợp đồng và giá trị thanh toán tăng theo số lần xuiất hiện rồi vì kết quả mình cần là giá trị hợ đồng không đổi, giá trị thanh toán cộng dồn. gửi bạn.

Không muốn cộng dồn cột giá trị hợp đồng thì xóa bỏ dòng 22
[GPECODE=vb]Public Sub TongHop()
Dim sArr(), dArr(), I As Long, K As Long, Dic As Object, Tem As String, DK As String
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("CHUNGTU")
sArr = .Range(.[B2], .[B2].End(xlDown)).Resize(, 11).Value2
End With
DK = Sheets("TonghopDuAn").[B2].Value2
ReDim dArr(1 To UBound(sArr, 1), 1 To 6)
For I = 1 To UBound(sArr, 1)
If sArr(I, 8) = DK Then
Tem = sArr(I, 8) & "#" & sArr(I, 2)
If Not Dic.Exists(Tem) Then
K = K + 1
Dic.Add Tem, K
dArr(K, 1) = sArr(I, 2)
dArr(K, 2) = sArr(I, 4)
dArr(K, 3) = sArr(I, 1)
dArr(K, 4) = sArr(I, 7)
dArr(K, 5) = sArr(I, 5)
dArr(K, 6) = sArr(I, 11)
Else
'dArr(Dic.Item(Tem), 5) = dArr(Dic.Item(Tem), 5) + sArr(I, 5) '-----------------------Xoa bo dong nay
dArr(Dic.Item(Tem), 6) = dArr(Dic.Item(Tem), 6) + sArr(I, 11)
End If
End If
Next I
With Sheets("TonghopDuAn")
.[A6:F100].ClearContents
If K Then .[A6].Resize(K, 6) = dArr
End With
Set Dic = Nothing
End Sub
[/GPECODE]

 

[phucbugis]

Có cách nào không phải dùng Dictionary không bạn Pa Tê or quanghai vì nếu Pa tê viết thế thì hợp đồng và giá trị thanh toán tăng theo số lần xuiất hiện rồi vì kết quả mình cần là giá trị hợ đồng không đổi, giá trị thanh toán cộng dồn. gửi bạn.

mình nghĩ bài toán lọc của bạn có thể dùng Advanced Filter , riêng cột Đã Thanh Toán và công thức cho Footer ---> chắc phải thêm 1 code riêng.

 

[vndat]

mình nghĩ bài toán lọc của bạn có thể dùng Advanced Filter , riêng cột Đã Thanh Toán và công thức cho Footer ---> chắc phải thêm 1 code riêng.

Với trình độ cò con của mình thì dictionany là quá cáo siêu còn cách của bạn là đúng hướng suy nghĩ của mình rồi nhưng vẫn chưa làm được bạn à. rất mong được trao đổi với bạn

 

[vndat]

cảm ơn bạn Pa Tê và Phucbugis từ hai code của hai bạn mình đã làm được 1 code hoàn chỉnh theo ý muốn tuy nhiên có một vấn đề chưa giải quyết được là ra thông báo khi chưa nhập dự án hoặc số dự án sai là mình chưa làm được, mong được tiếp tục chỉ giao.

 

[phucbugis]

Với trình độ cò con của mình thì dictionany là quá cáo siêu còn cách của bạn là đúng hướng suy nghĩ của mình rồi nhưng vẫn chưa làm được bạn à. rất mong được trao đổi với bạn

- hehe, ngồi mò cái Advanced Filter sao thấy "chua" quá, đành dùng thêm 1 cột phụ .
- bạn tải file (4) về xem ntn nhé !
- mình cài thử vào sự kiện Worksheet_Change tại ô B2.

LinK: https://www.mediafire.com/?j9tam6abre6zd1z

 

[Ba Tê]

cảm ơn bạn Pa Tê và Phucbugis từ hai code của hai bạn mình đã làm được 1 code hoàn chỉnh theo ý muốn tuy nhiên có một vấn đề chưa giải quyết được là ra thông báo khi chưa nhập dự án hoặc số dự án sai là mình chưa làm được, mong được tiếp tục chỉ giao.

Thêm một vài dòng trong SUB, thử xem sao:
Cho nó vào sự kiện Worksheet_Change, Thay đổi ô B2 là code chạy, khỏi phải bấm nút.

 

[Quang_Hải]

Có cách nào không phải dùng Dictionary không bạn Pa Tê or quanghai vì nếu Pa tê viết thế thì hợp đồng và giá trị thanh toán tăng theo số lần xuiất hiện rồi vì kết quả mình cần là giá trị hợ đồng không đổi, giá trị thanh toán cộng dồn. gửi bạn.

Sao gọi tên mình lên bảng trả bài vậy ta?
Bài này lọc rồi cộng dồn số tiền đã TT mình viết ngắn gọn trong 3 dòng code. Không Dic hay Array gì cả. Tin không?

 

[vndat]

Sao gọi tên mình lên bảng trả bài vậy ta?
Bài này lọc rồi cộng dồn số tiền đã TT mình viết ngắn gọn trong 3 dòng code. Không Dic hay Array gì cả. Tin không?

Lúc tối hôm qua thấy Quanghai có ghé chủ đề này, và cũng từng trao đổi với Quanghai trên diễn đàn này nên đánh giá cao, nên gửi cùng tham gia để mình được học hỏi thêm; tuy nhiên mình chưa hiểu quanghai định nghĩa 3 dòng code như thế nào thì không rõ lắm. Mong lắm Quanghai ơi! để mở rộng kiến thức.

 

[Quang_Hải]

Lúc tối hôm qua thấy Quanghai có ghé chủ đề này, và cũng từng trao đổi với Quanghai trên diễn đàn này nên đánh giá cao, nên gửi cùng tham gia để mình được học hỏi thêm; tuy nhiên mình chưa hiểu quanghai định nghĩa 3 dòng code như thế nào thì không rõ lắm. Mong lắm Quanghai ơi! để mở rộng kiến thức.

3 dòng code này, nhớ là bạn phải xài office 2007 nha

Sub loc()
Sheets("CHUNGTU").[A1:L10000].AdvancedFilter 2, [B2:B3], [A6:F6], True
[A7:F100].RemoveDuplicates 1
Range([F7], [F65536].End(3)).Formula = "=SUMIF(CHUNGTU!R2C3:R10000C3,RC[-5],CHUNGTU!R2C12:R10000C12)"
End Sub

 

[vndat]

Cảm ơn tất cả các bạn! mình học hỏi thêm rất nhiều điều từ đề tài này.
"Bể dốt mênh mông, quay đầu... là bờ ?!"
"Đi xa được ngàn dặm, khởi đầu một bước chân"