VBA lấy dữ liệu chưa đúng.

[hathanh349]

Ac Xem giúp e tại sao lọc theo tên 1 số GV mà lấy dữ liệu ra lại không đúng ah. AC sửa giúp e với ah
em cảm ơn

 

[snow25]

Ac Xem giúp e tại sao lọc theo tên 1 số GV mà lấy dữ liệu ra lại không đúng ah.
em cảm ơn

Bạn vứt lên đấy ai biết sai chỗ nào.Mà giải thích nguyên tắc mình xem nào.

 

[Phuocam]

Chắc là : Tổng kết bảng bên phải, điền vào cột E (Thực dạy)

Hahaha ...

 

[snow25]

Ac Xem giúp e tại sao lọc theo tên 1 số GV mà lấy dữ liệu ra lại không đúng ah. AC sửa giúp e với ah
em cảm ơn

Thử cái code này.

Sub tinh()
Dim i As Long, lr As Long, dic As Object, arr, data, a As Long, b As Long, tiet As Integer, j As Integer
Dim dk As String
Set dic = CreateObject("scripting.dictionary")
With Sheets("tuan 2")
     lr = .Range("c" & Rows.Count).End(xlUp).Row
     If lr < 6 Then Exit Sub
     .Range("E6:G" & lr).ClearContents
     arr = .Range("A6:G" & lr).Value
     For i = 1 To UBound(arr)
         dk = arr(i, 3)
         dic.Item(dk) = i
         arr(i, 7) = arr(i, 4)
     Next i
     data = .Range("I5:AA24").Value
     For j = 2 To UBound(data, 2)
         For i = 2 To UBound(data)
             If IsNumeric(data(i, 1)) Then
                tiet = data(i, j)
             Else
                dk = data(i, j)
                a = dic.Item(dk)
                If a Then
                   If InStr(arr(a, 5), data(1, j)) = 0 Then
                      If arr(a, 5) = Empty Then
                         arr(a, 5) = data(1, j) & "(" & data(i, 1) & ")"
                      Else
                         arr(a, 5) = arr(a, 5) & "+" & data(1, j) & "(" & data(i, 1) & ")"
                      End If
                   Else
                         arr(a, 5) = Left(arr(a, 5), Len(arr(a, 5)) - 1) & ", " & data(i, 1) & ")"
                   End If
                   arr(a, 6) = arr(a, 6) + tiet
                   arr(a, 7) = arr(a, 7) + tiet
               End If
             End If
         Next i
   Next j
   .Range("A6:G" & lr).Value = arr
   Set dic = Nothing
End With
End Sub

 

[Maika8008]

Thử cái code này.

Sub tinh()
Dim i As Long, lr As Long, dic As Object, arr, data, a As Long, b As Long, tiet As Integer, j As Integer
Dim dk As String
Set dic = CreateObject("scripting.dictionary")
With Sheets("tuan 2")
     lr = .Range("c" & Rows.Count).End(xlUp).Row
     If lr < 6 Then Exit Sub
     .Range("E6:G" & lr).ClearContents
     arr = .Range("A6:G" & lr).Value
     For i = 1 To UBound(arr)
         dk = arr(i, 3)
         dic.Item(dk) = i
         arr(i, 7) = arr(i, 4)
     Next i
     data = .Range("I5:AA24").Value
     For j = 2 To UBound(data, 2)
         For i = 2 To UBound(data)
             If IsNumeric(data(i, 1)) Then
                tiet = data(i, j)
             Else
                dk = data(i, j)
                a = dic.Item(dk)
                If a Then
                   If InStr(arr(a, 5), data(1, j)) = 0 Then
                      If arr(a, 5) = Empty Then
                         arr(a, 5) = data(1, j) & "(" & data(i, 1) & ")"
                      Else
                         arr(a, 5) = arr(a, 5) & "+" & data(1, j) & "(" & data(i, 1) & ")"
                      End If
                   Else
                         arr(a, 5) = Left(arr(a, 5), Len(arr(a, 5)) - 1) & ", " & data(i, 1) & ")"
                   End If
                   arr(a, 6) = arr(a, 6) + tiet
                   arr(a, 7) = arr(a, 7) + tiet
               End If
             End If
         Next i
   Next j
   .Range("A6:G" & lr).Value = arr
   Set dic = Nothing
End With
End Sub

Mấy chỗ "(" và "+" trong mấy dòng sau thêm khoảng trắng trước ( và trước sau + thì sẽ đẹp hơn:
If arr(a, 5) = Empty Then
arr(a, 5) = data(1, j) & " (" & data(i, 1) & ")"
Else
arr(a, 5) = arr(a, 5) & " + " & data(1, j) & " (" & data(i, 1) & ")"