Tách ký tự và tính tổng nhiều điều kiện (2 người xem)
- Thread starter mitdacdtd
- Ngày gửi
Người dùng đang xem chủ đề này
bebo021999
Thành viên gạo cội
- Tham gia
- 26/1/11
- Bài viết
- 6,033
- Được thích
- 8,808
- Giới tính
- Nam
- Nghề nghiệp
- GPE
G4:
Copy xuống và sang phải
Mã:
=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.
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&",",",",""))))
Dạ em có sửa ngay khi có được công thức rồi bác HieuCD ạ. Em cảm ơn nhé.
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.
HUONGLIEN6577
Thành viên chính thức
- Tham gia
- 17/5/21
- Bài viết
- 57
- Được thích
- 73
- Giới tính
- Nữ
- Nghề nghiệp
- giáo viên MN
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
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)
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
dazkangel
<New Horizons>
- Tham gia
- 28/2/17
- Bài viết
- 2,880
- Được thích
- 4,040
- Giới tính
- Nam
Công thức chỉnh lại tý:
Mã:
=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)),))HUONGLIEN6577
Thành viên chính thức
- Tham gia
- 17/5/21
- Bài viết
- 57
- Được thích
- 73
- Giới tính
- Nữ
- Nghề nghiệp
- giáo viên MN
Tuyệ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.
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
Dạ 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.
HUONGLIEN6577
Thành viên chính thức
- Tham gia
- 17/5/21
- Bài viết
- 57
- Được thích
- 73
- Giới tính
- Nữ
- Nghề nghiệp
- giáo viên MN
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.
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.
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 được
Mã:
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))
Bài đã được tự động gộp:
Mình quên gởi code
, xem code trong file BCKDT (2)
Lần chỉnh sửa cuối:
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.
Lần chỉnh sửa cuối:
HUONGLIEN6577
Thành viên chính thức
- Tham gia
- 17/5/21
- Bài viết
- 57
- Được thích
- 73
- Giới tính
- Nữ
- Nghề nghiệp
- giáo viên MN
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
If DL(k, j) <> "" Then
DK = DL(k, j)
'End If'Sai dong lenh nay
'Cac lenh duoi van chay khi DL(k, j) = ""
là nguyên nhân chính dẫn đến kqua ra sai.
Cái đoạn
'd1 = sh1.Cells(65536, i).End(xlUp).Row '65536 la so dong cua Excel 2003
tôi viết có ý là dữ liệu của CĐ x nào đó có thể có số người nhiều hơn số người của công đoạn có cột A. Nếu chỉ lấy số người theo cột A của mỗi Sh thì dẫn đến khi tổng hợp sẽ thiếu.
Một lần nữa trân trọng cảm ơn anh!
Lần chỉnh sửa cuối:
