Em muốn tính cột điểm có liên quan đến nhiều sheet mà làm không được nhờ anh chị giúp (1 người xem)

[nguyentruonglinh]

Em đã đưa câu hỏi ở phần sheet hành trình theo chân Bác. nhờ anh chị GPE giúp đở.

 

[Quang_Hải]

Em đã đưa câu hỏi ở phần sheet hành trình theo chân Bác. nhờ anh chị GPE giúp đở.

Nếu biết xài code thì copy code này vào 1 module rồi chạy thử xem

Sub test()
Dim sh, data(), kq(1 To 65536, 1 To 3), i, k
With CreateObject("scripting.dictionary")
   For Each sh In Worksheets
      If sh.CodeName <> "Sheet11" Then
            data = sh.Range(sh.[A6], sh.[A65536].End(3)).Resize(, 30).Value
            For i = 1 To UBound(data)
               If data(i, 30) >= 5 Then
                  If Not .exists(data(i, 2)) Then
                     k = k + 1
                    .Add data(i, 2), k
                     kq(k, 1) = k
                     kq(k, 2) = data(i, 2)
                     kq(k, 3) = data(i, 30)
                  Else
                     kq(.Item(data(i, 2)), 3) = kq(.Item(data(i, 2)), 3) + data(i, 30)
                  End If
               End If
            Next
      End If
   Next
End With
Sheet11.[A6].Resize(k, 3) = kq
End Sub

 

[nguyentruonglinh]

Bạn ơi tất cả điểm đó x 4 thì sửa code chổ nào vậy?

 

[Ba Tê]

Nếu biết xài code thì copy code này vào 1 module rồi chạy thử xem

Sub test()
Dim sh, data(), kq(1 To 65536, 1 To 3), i, k
With CreateObject("scripting.dictionary")
   For Each sh In Worksheets
      If sh.CodeName <> "Sheet11" Then
            data = sh.Range(sh.[A6], sh.[A65536].End(3)).Resize(, 30).Value
            For i = 1 To UBound(data)
               If data(i, 30) >= 5 Then
                  If Not .exists(data(i, 2)) Then
                     k = k + 1
                    .Add data(i, 2), k
                     kq(k, 1) = k
                     kq(k, 2) = data(i, 2)
                     kq(k, 3) = data(i, 30)
                  Else
                     kq(.Item(data(i, 2)), 3) = kq(.Item(data(i, 2)), 3) + data(i, 30)
                  End If
               End If
            Next
      End If
   Next
End With
Sheet11.[A6].Resize(k, 3) = kq
End Sub

Hình như...hình như tác giả còn yêu cầu Tổng nhân với 4 nữa Hải ơi.

Em muốn tính điểm hành trình như sau: (Tổng điểm môn toán >=5 + Tổng điểm môn lí >=5+Tổng điểm môn công nghệ >=5+Tổng điểm mônngữ văn >=5+Tổng điểm môn lịch sử >=5+Tổng điểm môn địa lí >=5+Tổng điểm môn GDCD >=5+Tổng điểm môn ngoai ngữ >=5+Tổng điểm môn tin học >=5+Tổng điểm môn sinh >=5)*4

 

[Hoàng Trọng Nghĩa]

Hình như...hình như tác giả còn yêu cầu Tổng nhân với 4 nữa Hải ơi.

Với dạng này bác Ba Tê chỉnh lại code của anh Quang Hai trong vòng 30 giây ấy mà! Sao không chỉnh luôn đi còn théc méc ta???

 

[concogia]

Với dạng này bác Ba Tê chỉnh lại code của anh Quang Hai trong vòng 30 giây ấy mà! Sao không chỉnh luôn đi còn théc méc ta???

Vậy:
Với dạng này Nghĩa chỉnh lại code của anh Quang Hai trong vòng "bi nhiêu" giây mà sao không chỉnh luôn lại đi còn "théc méc" tập 2 "dzị" ta ???
Híc, không chơi théc méc tiếp à nha

 

[Ba Tê]

Với dạng này bác Ba Tê chỉnh lại code của anh Quang Hai trong vòng 30 giây ấy mà! Sao không chỉnh luôn đi còn théc méc ta???

Thấy Quang Hải còn đèn xanh lè, để Hải chỉnh lại cho "trọn bộ".
Bi giờ tắt đèn đi ngủ rồi. Thêm thí thí 1 For Next nữa xem sao, hổng biết vừa ý của tác giả không.

Option Explicit

Sub test()
Dim sh, data(), kq(1 To 65536, 1 To 3), i, k
With CreateObject("scripting.dictionary")
   For Each sh In Worksheets
      If sh.CodeName <> "Sheet11" Then
            data = sh.Range(sh.[A6], sh.[A65536].End(3)).Resize(, 30).Value
            For i = 1 To UBound(data)
               If data(i, 30) >= 5 Then
                  If Not .exists(data(i, 2)) Then
                     k = k + 1
                    .Add data(i, 2), k
                     kq(k, 1) = k
                     kq(k, 2) = data(i, 2)
                     kq(k, 3) = data(i, 30)
                  Else
                     kq(.Item(data(i, 2)), 3) = kq(.Item(data(i, 2)), 3) + data(i, 30)
                  End If
               End If
            Next
      End If
   Next
End With
For i = 1 To UBound(kq, 1)
    kq(i, 3) = kq(i, 3) * 4
Next i
Sheet11.[A6].Resize(k, 3) = kq
End Sub

Còn 1 lão "thập thò kiếm chuyện" nữa

Vậy:
Với dạng này Nghĩa chỉnh lại code của anh Quang Hai trong vòng "bi nhiêu" giây mà sao không chỉnh luôn lại đi còn "théc méc" tập 2 "dzị" ta ???
Híc, không chơi théc méc tiếp à nha

 

[nguyentruonglinh]

Em test rùi. mà kết quả ra sai anh oi. em tính tay thì em đầu tiên phải có số điểm = 1294.1, anh xem lại giúp em với

 

[Hoàng Trọng Nghĩa]

Em test rùi. mà kết quả ra sai anh oi. em tính tay thì em đầu tiên phải có số điểm = 1294.1, anh xem lại giúp em với

Cho tôi hỏi, tại sao tất cả các sheet đều có mã học sinh, thế nhưng sheet "Hành trình theo chân Bác" lại không có cột này vậy? Gặp những trường hợp trùng tên thì cộng nhầm làm sao?

 

[ndu96081631]

Em test rùi. mà kết quả ra sai anh oi. em tính tay thì em đầu tiên phải có số điểm = 1294.1, anh xem lại giúp em với

Bạn tính hay thiệt
Chỉ có 10 môn... Cứ cho rằng môn nào cũng 10 điểm, vậy 10 môn là 100 điểm. Nhân với 4 cũng chỉ có 400 điểm
Ở đâu ra mà trên 1000 điểm vậy?

 

[Ba Tê]

Em test rùi. mà kết quả ra sai anh oi. em tính tay thì em đầu tiên phải có số điểm = 1294.1, anh xem lại giúp em với

"Chời đất".
Diễn tả khó hiểu nên mọi người làm theo kiểu khác.
Thử lại code này xem sao, kết quả em đầu tiên là 1294.8 không giống của bạn. Kiểm tra lại xem code sai hay bạn sai.

Option Explicit


Public Sub GPE()
Dim Ws As Worksheet, Dic As Object, I As Long, J As Long, K As Long
Dim Tem As String, Tong As Double, Sarr(), Darr(1 To 100, 1 To 3)
Set Dic = CreateObject("Scripting.Dictionary")
For Each Ws In Worksheets
    If Ws.Name <> Sheet11.Name Then
        Sarr = Ws.Range(Ws.[A6], Ws.[A65000].End(xlUp)).Resize(, 30).Value
        For I = 1 To UBound(Sarr, 1)
            Tem = UCase(Sarr(I, 4))
                For J = 5 To 30
                    If Sarr(I, J) >= 5 Then Tong = Tong + Sarr(I, J)
                Next J
            If Not Dic.Exists(Tem) Then
                K = K + 1: Dic.Add Tem, K
                Darr(K, 1) = K
                Darr(K, 2) = Sarr(I, 2)
                Darr(K, 3) = Tong
            Else
                Darr(Dic.Item(Tem), 3) = Darr(Dic.Item(Tem), 3) + Tong
            End If
            Tong = 0
        Next I
    End If
Next Ws
For I = 1 To UBound(Darr, 1)
    Darr(I, 3) = Darr(I, 3) * 4
Next I
With Sheet11
    .[A6:C100].ClearContents
    If K Then .[A6].Resize(K, 3).Value = Darr
End With
Set Dic = Nothing
End Sub

 

[ndu96081631]

"Chời đất".
Diễn tả khó hiểu nên mọi người làm theo kiểu khác.
Thử lại code này xem sao, kết quả em đầu tiên là 1294.8 không giống của bạn. Kiểm tra lại xem code sai hay bạn sai.

Theo như code của anh Ba Tê thì có nghĩa là cộng tất tần tật điểm từ cột E đến cột AD
Nếu cấu trúc các sheet là như nhau thì công thức cũng làm được. Quy trình như sau:
- Gõ tên các sheet vào cột AE (sheet Hành trình theo chân Bác)
- Có tất cả 10 sheet, vậy tên sheet sẽ được liệt kê từ AE1 đến AE10
- Công thức cho C6 sẽ là:

=4*SUMPRODUCT(SUMIF(INDIRECT("'"&$AE$1:$AE$10&"'!E"&ROWS($1:6)&":AD"&ROWS($1:6)),">=5"))

Kéo fill xuống