VBA TÍNH ĐIỂM THI THEO MÔN

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài

1050167

Thành viên mới
Tham gia
16/6/15
Bài viết
29
Được thích
0
Chào tất cả mọi người trong diễn đàn. Em có file excel này chạy VBA, em muốn sheet THONG KE tính đến dòng 32 mà không được (Lúc trước tính đến dòng 18). Nhờ mọi người giúp đỡ dùm em ạ!
 
Lần chỉnh sửa cuối:
Chào tất cả mọi người trong diễn đàn. Em có file excel này chạy VBA, em muốn sheet THONG KE tính đến dòng 32 mà không được (Lúc trước tính đến dòng 18). Nhờ mọi người giúp đỡ dùm em ạ!
Sửa như này đi.
Mã:
Sub abc()
    Dim i As Long, arr, dic As Object, dk As String, diem As Integer, T, b As Integer, c As Integer
    Dim j As Integer, so As Integer, lr As Long, data, d As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("diem thi")
         lr = .Range("E" & Rows.Count).End(xlUp).Row
         If lr < 4 Then Exit Sub
         data = .Range("E4:N" & lr).Value
    End With
'
    With Sheets("thong ke")
        .Range("C5:T32").ClearContents
        arr = .Range("B3:T32").Value
        For i = 4 To 14
            T = Split(arr(2, i), "-")
            b = T(0) * 100
            c = T(1) * 100
            For j = b To c
                dic.Item(j) = i
            Next j
        Next i
        For i = 3 To UBound(arr)
            dic.Item(arr(i, 1)) = i
        Next i
        dk = .Range("o2").Value
        For i = 2 To 10
            If data(1, i) = dk Then
               so = i
               Exit For
            End If
        Next i
        If so = 0 Then MsgBox "sai": Exit Sub
        For i = 2 To UBound(data)
            b = dic.Item(data(i, 1))
            If b Then
               arr(b, 2) = arr(b, 2) + 1
               If data(i, so) = Empty Then
                  arr(b, 3) = arr(b, 3) + 1
               Else
               If data(i, so) > 4.9 Then arr(b, 15) = arr(b, 15) + 1
               d = data(i, so) * 100
               c = dic.Item(d)
               arr(b, c) = arr(b, c) + 1
               If arr(b, 17) <= data(i, so) Then arr(b, 17) = data(i, so)
               If arr(b, 18) = Empty Then
                  arr(b, 18) = data(i, so)
               ElseIf arr(b, 18) >= data(i, so) Then
                   arr(b, 18) = data(i, so)
               End If
                 arr(b, 19) = arr(b, 19) + data(i, so) * 1
               End If
            End If
        Next i
        For i = 3 To UBound(arr)
            If arr(i, 19) Then arr(i, 19) = arr(i, 19) / (arr(i, 2) - arr(i, 3))
            If arr(i, 15) Then arr(i, 16) = arr(i, 15) / (arr(i, 2) - arr(i, 3))
        Next i
        .Range("B3:T32").Value = arr
    End With
    Set dic = Nothing
End Sub
 
Upvote 0
Chắc là nên sửa tiêu đề trước nhỉ, nhưng ván đã đóng thuyền rồi.
Ván đóng thuyền còn đỡ tức.
Ở đây là một mụ nạ dòng. Ngồi buồn mụ ta la làng cho thiên hạ chú ý thôi chứ tự bản thân chỉ cần suy nghĩ chút là tự giải quyết được.
 
Upvote 0
2ua cầu rút ván rồi; Chắc chắn rằng không phải đem ván đó đóng thuyền, cá trên sông hay trên biển cũng là cá
 
Upvote 0
Web KT
Back
Top Bottom