Lấy dữ liệu từ sheet này sang sheet khác theo điều kiện dữ liệu cần lấy (1 người xem)

[giangcoilove]

Thưa các anh chi

Là e có 1 sheet tổng hợp công tháng với số lượng khủng, em cần dò số liệu OT mà các nhân viên đã đăng ký từ sheet OT . Bây giờ em muốn khi mình nhập dữ liệu ở sheet check và bấm nút thì cột giờ OT của sheet OT sẽ chạy sang tương ứng,theo ma số nhân viên và ngày công em đã bôi xanh ở sheet OT và em muốn kết chuyển cột OT cột G của sheet OT sang sheet Check.em dùng hàm macth thì chạy rất lâu, làm ơn cho em cái VAB
Lần trước em cũng xin 1 file dò công rồi, nhưng em ngâm cứu mãi vẫn không thể nào làm giống được, vả lại em cũng không biết làm sao cho nút buttion nó hoạt động nữa

Các anh chị giúp em với. em xin cảm ơn

 

[snow25]

Thưa các anh chi

Là e có 1 sheet tổng hợp công tháng với số lượng khủng, em cần dò số liệu OT mà các nhân viên đã đăng ký từ sheet OT . Bây giờ em muốn khi mình nhập dữ liệu ở sheet check và bấm nút thì cột giờ OT của sheet OT sẽ chạy sang tương ứng,theo ma số nhân viên và ngày công em đã bôi xanh ở sheet OT và em muốn kết chuyển cột OT cột G của sheet OT sang sheet Check.em dùng hàm macth thì chạy rất lâu, làm ơn cho em cái VAB
Lần trước em cũng xin 1 file dò công rồi, nhưng em ngâm cứu mãi vẫn không thể nào làm giống được, vả lại em cũng không biết làm sao cho nút buttion nó hoạt động nữa

Các anh chị giúp em với. em xin cảm ơn

Bạn xem code này đúng không nhé.Bạn bấm vào Chỗ OT là chạy code.

Sub chuyendulieu()
    Dim arr, arr1, dic As Object, i As Long, lr As Long, dk As String
     Set dic = CreateObject("scripting.dictionary")
    With Sheets("OT")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A5:G" & lr).Value
         For i = 1 To UBound(arr, 1)
             dk = arr(i, 1) & "#" & CLng(CDate(arr(i, 3)))
             dic.Item(dk) = arr(i, 7)
         Next i
    End With
    With Sheets("check")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr < 5 Then Exit Sub
            arr = .Range("B5:E" & lr).Value
            ReDim arr1(1 To UBound(arr, 1), 1 To 1)
            For i = 1 To UBound(arr, 1)
                dk = arr(i, 1) & "#" & CLng(CDate(arr(i, 4)))
                If dic.exists(dk) Then
                   arr1(i, 1) = dic.Item(dk)
                End If
            Next i
           .Range("K5:K" & lr).Value = arr1
   End With
End Sub

 

[giangcoilove]

Bạn xem code này đúng không nhé.Bạn bấm vào Chỗ OT là chạy code.

Sub chuyendulieu()
    Dim arr, arr1, dic As Object, i As Long, lr As Long, dk As String
     Set dic = CreateObject("scripting.dictionary")
    With Sheets("OT")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A5:G" & lr).Value
         For i = 1 To UBound(arr, 1)
             dk = arr(i, 1) & "#" & CLng(CDate(arr(i, 3)))
             dic.Item(dk) = arr(i, 7)
         Next i
    End With
    With Sheets("check")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr < 5 Then Exit Sub
            arr = .Range("B5:E" & lr).Value
            ReDim arr1(1 To UBound(arr, 1), 1 To 1)
            For i = 1 To UBound(arr, 1)
                dk = arr(i, 1) & "#" & CLng(CDate(arr(i, 4)))
                If dic.exists(dk) Then
                   arr1(i, 1) = dic.Item(dk)
                End If
            Next i
           .Range("K5:K" & lr).Value = arr1
   End With
End Sub

em chân thành cám ơn ak.. đúng rồi ak

 

[giangcoilove]

Hi anh oi
Hiện tại em đang chạy trên file này, nhưng với dữ liệu khủng , khoãng hơn 400000 dòng, thì khi e click macro nó báo lỗi. nó không chạy anh ơi. Có cách nào giúp em ko ak

Và cái nút buttion anh có thể dời nó đi sang chỗ khác được không ak, vì cột đó là cột em cần lọc những dữ liệu cần lấy

 

[HieuCD]

Hi anh oi
Hiện tại em đang chạy trên file này, nhưng với dữ liệu khủng , khoãng hơn 400000 dòng, thì khi e click macro nó báo lỗi. nó không chạy anh ơi. Có cách nào giúp em ko ak

Và cái nút buttion anh có thể dời nó đi sang chỗ khác được không ak, vì cột đó là cột em cần lọc những dữ liệu cần lấy

Bấm chuột phải để dời button
Thử chỉnh tí tẹo code

Sub chuyendulieu()
    Dim arr(), arr1(), dic As Object, i As Long, lr As Long, dk As String
     Set dic = CreateObject("scripting.dictionary")
    With Sheets("OT")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A5:G" & lr).Value2
         For i = 1 To UBound(arr, 1)
             dk = arr(i, 1) & "#" & arr(i, 3)
             dic.Item(dk) = arr(i, 7)
         Next i
    End With
    With Sheets("check")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr < 5 Then Exit Sub
            arr = .Range("B5:E" & lr).Value2
            ReDim arr1(1 To UBound(arr, 1), 1 To 1)
            For i = 1 To UBound(arr, 1)
                dk = arr(i, 1) & "#" & arr(i, 4)
                If dic.exists(dk) Then
                   arr1(i, 1) = dic.Item(dk)
                End If
            Next i
           .Range("K5:K" & lr).Value = arr1
   End With
End Sub