=SUMPRODUCT(($A$3:$A$8=G$3)*ISNUMBER(SEARCH(F4,$B$3:$B$8))*$C$3:$C$8/(LEN($B$3:$B$8&",")-LEN(SUBSTITUTE($B$3:$B$8&",",",",""))))
Dạ đúng luôn ạ. Em cảm ơn rất nhiều.G4:
Copy xuống và sang phảiMã:=SUMPRODUCT(($A$3:$A$8=G$3)*ISNUMBER(SEARCH(F4,$B$3:$B$8))*$C$3:$C$8/(LEN($B$3:$B$8&",")-LEN(SUBSTITUTE($B$3:$B$8&",",",",""))))
kiểm tra lại F4G4:
Copy xuống và sang phảiMã:=SUMPRODUCT(($A$3:$A$8=G$3)*ISNUMBER(SEARCH(F4,$B$3:$B$8))*$C$3:$C$8/(LEN($B$3:$B$8&",")-LEN(SUBSTITUTE($B$3:$B$8&",",",",""))))
Dạ em có sửa ngay khi có được công thức rồi bác HieuCD ạ. Em cảm ơn nhé.kiểm tra lại F4
=SUMPRODUCT(($A$3:$A$8=G$3)*ISNUMBER(SEARCH(F4,$B$3:$B$8))*$C$3:$C$8/(LEN($B$3:$B$8&",")-LEN(SUBSTITUTE($B$3:$B$8&",",",",""))))
Em chào bác.G4:
Copy xuống và sang phảiMã:=SUMPRODUCT(($A$3:$A$8=G$3)*ISNUMBER(SEARCH(F4,$B$3:$B$8))*$C$3:$C$8/(LEN($B$3:$B$8&",")-LEN(SUBSTITUTE($B$3:$B$8&",",",",""))))
Của bạn đây, Mình làm theo kiểu cùi bắp, do code học mót từng tý một của anh chị em trên diễn đàn mà.Em chào bác.
Liên quan đến nội dung trên nhưng giờ có thay đổi chút ít ạ:
1. Dữ liệu được ghi nhận ở Sheet DT1 và DT2: có nhiều công đoạn và nhiều cột
2. Tính toán tổng hợp thì sang Sheet TH
Bác giúp lại em với nhé (theo file đính kèm)
Em cảm ơn.
Cảm ơn bác nhiều. Nếu có phần công thức thì hay quá ạ (để em tự tùy biến điều chỉnh)Của bạn đây, Mình làm theo kiểu cùi bắp, do code học mót từng tý một của anh chị em trên diễn đàn mà.
Hy vọng đúng ý bạn. Bạn hãy thêm ỏ một công đoạn nòa đó nhiều hoặc ít hơn số dòng cho trước, hoặc thêm tên vào để chạy thử nhé.
Mong mọi người xen và góp ý để co de ngắn và chạy nhanh hơn. Trân trọng
Bài nầy nên dùng code VBAEm chào bác.
Liên quan đến nội dung trên nhưng giờ có thay đổi chút ít ạ:
1. Dữ liệu được ghi nhận ở Sheet DT1 và DT2: có nhiều công đoạn và nhiều cột
2. Tính toán tổng hợp thì sang Sheet TH
Bác giúp lại em với nhé (theo file đính kèm)
Em cảm ơn.
Option Base 1
Sub XYZ()
Dim dic As New Scripting.Dictionary, aSh, sArr(), S, aTieuDe(), Res()
Dim sRow&, sCol&, n&, r&, i&, iR&, j&, jC&, c&, k&
Dim ten$, ngay
aSh = Array("DT1", "DT2")
ReDim sArr(1 To UBound(aSh))
For n = 1 To 2
With Sheets(aSh(n))
i = .Range("A" & Rows.Count).End(xlUp).Row
j = .Cells(2, Columns.Count).End(xlToLeft).Column
sArr(n) = .Range("A3", .Cells(i, j)).Value
End With
Next n
ReDim Res(1 To 1000, 1 To 11) '1000: So nguoi nhieu nhat
ReDim aTieuDe(1 To 2, 2 To 11)
c = 0: k = 0
For n = 1 To 2
sRow = UBound(sArr(n)): sCol = UBound(sArr(n), 2)
For j = 1 To sCol Step 4
For i = 1 To sRow
ten = sArr(n)(i, j): ngay = sArr(n)(i, j + 3)
If ten <> Empty Then
If dic.Exists(ngay) = False Then
c = c + 2
dic.Add ngay, c
If UBound(Res, 2) < c + 1 Then
ReDim Preserve aTieuDe(1 To 2, 2 To c + 11)
ReDim Preserve Res(1 To 1000, 1 To c + 11)
End If
aTieuDe(1, c) = ngay
aTieuDe(2, c) = "TGDM": aTieuDe(2, c + 1) = "TGTT"
End If
jC = dic.Item(ngay)
S = Split(" " & Application.Trim(Replace(ten, ",", "")), " ")
sArr(n)(i, j + 1) = sArr(n)(i, j + 1) / UBound(S)
sArr(n)(i, j + 2) = sArr(n)(i, j + 2) / UBound(S)
For r = 1 To UBound(S)
If dic.Exists(S(r)) = False Then
k = k + 1
dic.Add S(r), k
Res(k, 1) = S(r)
End If
iR = dic.Item(S(r))
If sArr(n)(i, j + 1) <> Empty Then Res(iR, jC) = Res(iR, jC) + sArr(n)(i, j + 1)
If sArr(n)(i, j + 2) <> Empty Then Res(iR, jC + 1) = Res(iR, jC + 1) + sArr(n)(i, j + 2)
Next r
End If
Next i
Next j
Next n
With Sheets("TH")
i = .Range("A" & Rows.Count).End(xlUp).Row
j = .Cells(3, Columns.Count).End(xlToLeft).Column
If j > 1 Then .Range("B2", .Cells(3, j)).ClearContents
If i > 3 And j > 2 Then .Range("A4", .Cells(i, j)).ClearContents
.Range("A4").Resize(k, c + 1) = Res
.Range("B2").Resize(2, c + 1) = aTieuDe
End With
Set dic = Nothing
End Sub
=SUM(IFERROR(OFFSET('DT1'!$B$3:$R$13,,0+(B$3="TGTT"))/(LEN('DT1'!$A$3:$Q$13)-LEN(SUBSTITUTE('DT1'!$A$3:$Q$13,",",""))+1)*ISNUMBER(FIND($A4,'DT1'!$A$3:$Q$13))*('DT1'!$D$3:$T$13=LOOKUP(9^9,$B$2:B$2)),),IFERROR(OFFSET('DT2'!$B$3:$R$13,,0+(B$3="TGTT"))/(LEN('DT2'!$A$3:$Q$13)-LEN(SUBSTITUTE('DT2'!$A$3:$Q$13,",",""))+1)*ISNUMBER(FIND($A4,'DT2'!$A$3:$Q$13))*('DT2'!$D$3:$T$13=LOOKUP(9^9,$B$2:B$2)),))
Tuyệt vời, Code của anh chạy nhanh và chính xácBài nầy nên dùng code VBA
Code nên viết canh cột chuẩn dể đọc hơn, Dim các biến nhiều dòng làm phân tâm, gom các biến theo tiêu chuẩn nào đó vào cùng dòng cho gọnTuyệt vời, Code của anh chạy nhanh và chính xác
cảm ơn anh, nếu anh không viết code cho bài này thì tôi cũng không biết Code của mình chạy cho ra kết quả sai. Do làm xong không kiểm tra lại kỹ (thực ra mới kiểm tra kết quả của Hải-có thay đổi số liệu để kiểm tra), và chủ quan nghĩ thuật toán của mình là đúng rồi.
Nếu có thể anh có thể kiểm tra và phân tích chỉ ra chỗ sai trong code của tôi được không?
Mong anh giúp đỡ.
Trân trọng.
Dạ cảm ơn bác HieeuCD; em làm được rồi ạ.Bài nầy nên dùng code VBA
Mã:Option Base 1 Sub XYZ() Dim dic As New Scripting.Dictionary, aSh, sArr(), S, aTieuDe(), Res() Dim sRow&, sCol&, n&, r&, i&, iR&, j&, jC&, c&, k& Dim ten$, ngay aSh = Array("DT1", "DT2") ReDim sArr(1 To UBound(aSh)) For n = 1 To 2 With Sheets(aSh(n)) i = .Range("A" & Rows.Count).End(xlUp).Row j = .Cells(2, Columns.Count).End(xlToLeft).Column sArr(n) = .Range("A3", .Cells(i, j)).Value End With Next n ReDim Res(1 To 1000, 1 To 11) '1000: So nguoi nhieu nhat ReDim aTieuDe(1 To 2, 2 To 11) c = 0: k = 0 For n = 1 To 2 sRow = UBound(sArr(n)): sCol = UBound(sArr(n), 2) For j = 1 To sCol Step 4 For i = 1 To sRow ten = sArr(n)(i, j): ngay = sArr(n)(i, j + 3) If ten <> Empty Then If dic.Exists(ngay) = False Then c = c + 2 dic.Add ngay, c If UBound(Res, 2) < c + 1 Then ReDim Preserve aTieuDe(1 To 2, 2 To c + 11) ReDim Preserve Res(1 To 1000, 1 To c + 11) End If aTieuDe(1, c) = ngay aTieuDe(2, c) = "TGDM": aTieuDe(2, c + 1) = "TGTT" End If jC = dic.Item(ngay) S = Split(" " & Application.Trim(Replace(ten, ",", "")), " ") sArr(n)(i, j + 1) = sArr(n)(i, j + 1) / UBound(S) sArr(n)(i, j + 2) = sArr(n)(i, j + 2) / UBound(S) For r = 1 To UBound(S) If dic.Exists(S(r)) = False Then k = k + 1 dic.Add S(r), k Res(k, 1) = S(r) End If iR = dic.Item(S(r)) If sArr(n)(i, j + 1) <> Empty Then Res(iR, jC) = Res(iR, jC) + sArr(n)(i, j + 1) If sArr(n)(i, j + 2) <> Empty Then Res(iR, jC + 1) = Res(iR, jC + 1) + sArr(n)(i, j + 2) Next r End If Next i Next j Next n With Sheets("TH") i = .Range("A" & Rows.Count).End(xlUp).Row j = .Cells(3, Columns.Count).End(xlToLeft).Column If j > 1 Then .Range("B2", .Cells(3, j)).ClearContents If i > 3 And j > 2 Then .Range("A4", .Cells(i, j)).ClearContents .Range("A4").Resize(k, c + 1) = Res .Range("B2").Resize(2, c + 1) = aTieuDe End With Set dic = Nothing End Sub
Cảm ơn anh đã động viên, tôi cũng mới học mót VBA của các anh chị em trên diễn đàn, gọi là góp vui chứ cũng không dám múa rìu, múa kiếm... gì đâu.Code nên viết canh cột chuẩn dể đọc hơn, Dim các biến nhiều dòng làm phân tâm, gom các biến theo tiêu chuẩn nào đó vào cùng dòng cho gọn
Đã dùng mảng thì cố gắng dùng mảng hết không nên chen ngang dùng range
Code chỉ sai dòng lệnh ghi chú trong code
Trước đây khi mình mới lên diễn đàn học viết code, khi viết xong 1 code chạy được, vài ngày sao xem lại và tìm cách thay đổi 1 vài lệnh hoặc thay đổi hoàn toàn, tuần sau tháng sau nếu có ý tưởng mới tiếp tục mở ra xem lại ... từ từ mới nắm được các cách viết khác nhau
Mới tập viết code mà viết được code phức tạp như bài nầy chứng tỏ bạn rất giỏi
Công thức khá phức tạp, bạn dùng công thức mảng bài #10 của bạn @dazkangel hoặc công thức của mình đều đượcDạ cảm ơn bác HieeuCD; em làm được rồi ạ.
Với mong muốn có thêm công thức excel (để tự điều chỉnh được vì em chưa biết tý gì VBA), nếu bác có thời gian giúp em với nhé.
Em cảm ơn bác nhiều nhiều
P/S: trong group của mình, em hâm mộ bác Hiệp và bác Hiếu.
B4 =SUM(IFERROR(('DT1'!$D$3:$T$13=A$2+B$2)*ISNUMBER(FIND($A4,'DT1'!$A$3:$Q$13))*OFFSET('DT1'!$B$3:$R$13,,N(B$3="TGTT"))/(LEN('DT1'!$A$3:$Q$13)-LEN(SUBSTITUTE('DT1'!$A$3:$Q$13,",",""))+1),0)+IFERROR(('DT2'!$D$3:$T$13=A$2+B$2)*ISNUMBER(FIND($A4,'DT2'!$A$3:$Q$13))*OFFSET('DT2'!$B$3:$R$13,,N(B$3="TGTT"))/(LEN('DT2'!$A$3:$Q$13)-LEN(SUBSTITUTE('DT2'!$A$3:$Q$13,",",""))+1),0))
Mình quên gởi codeCảm ơn anh đã động viên, tôi cũng mới học mót VBA của các anh chị em trên diễn đàn, gọi là góp vui chứ cũng không dám múa rìu, múa kiếm... gì đâu.
Thực sự tôi có rất nhiều bài thấy hay (thấy sức mạnh của code trong giả quyết vấn đề mà bạn đọc yêu cầu- chính vì điều này mà tôi đam mê học VBA), nhưng đọc code thì chẳng hiểu gì. thật buồn, nhưng vẫn cố gắng. Nói thật lòng là có bài tôi viết đến 1-2 giờ sáng, hoặc bỏ cả cơm dể viết code, chạy thử, viết lại...chỉ vì một điều đó là thỏa mãn sự đam mê chứ không vì mục đích nào khác.
Nếu có thể, anh xem lại code của tôi ỏ bài này, chú giải những điểm thừa thiếu, sai...được không? để hạn chế những sai sot đáng tiếc cho những lần sau.
Anh cố gắng giúp tôi nhé.
P/S: qua code của anh ở bài này, tôi học được một ít kiến thức là : mảng nhỏ trong mảng lớn, những kiến thức khác tôi sẽ học hỏi dân dần. Riếng cái chỗ anh gán một phần tử của mảng( mảng S =Split(" " & Application.Trim(Replace(ten, ",", "")), " "), gồm nhiều tên, phân cách nhau bằng dấu ","), sau đó lấy ra từng phần tử Res(k, 1) = S(r) để gán vào mảng lớn thì lúc viết code tôi không thể làm được. Mày mò mãi cũng không được nên đành gán xuống sheet và cho nó vào mảng lớn hơn,
Chỗ lấy được số lượng để chia bình quân cho số người, tôi không hiểu là tại sao mà kết quả trả về vẫn sai. Tôi đã mất cả buổi sáng nay để mò mà vẫn không ra. anh giúp tôi với nhé.
Trân trọng.
EM vừa up vào. Có gì em lại hỏi anh tiếp nhé. Em cảm ơn nhiều nhiều.=SUM(IFERROR(('DT1'!$D$3:$T$13=A$2+B$2)*ISNUMBER(FIND($A4,'DT1'!$A$3:$Q$13))*OFFSET('DT1'!$B$3:$R$13,,N(B$3="TGTT"))/(LEN('DT1'!$A$3:$Q$13)-LEN(SUBSTITUTE('DT1'!$A$3:$Q$13,",",""))+1),0)+IFERROR(('DT2'!$D$3:$T$13=A$2+B$2)*ISNUMBER(FIND($A4,'DT2'!$A$3:$Q$13))*OFFSET('DT2'!$B$3:$R$13,,N(B$3="TGTT"))/(LEN('DT2'!$A$3:$Q$13)-LEN(SUBSTITUTE('DT2'!$A$3:$Q$13,",",""))+1),0))
Cảm ơn anh đã dành thời gian để phân tích và chỉ ra những chỗ thừa, sai... đoạn code của tôi. Cái chỗMình quên gởi code, xem code trong file BCKDT (2)