Hiện kết quả bằng code VBA

[soledad_90]

Em xin chào diễn đàn.
Hiện em đang có file theo giõi với chi tiết nhiều dữ liệu theo từng ngày phát sinh, cần sự giúp đỡ của diễn đàn để thưc hiện công việc được thuận lợi hơn ạ.
Với chi tiết yêu cầu :

Cột 11 : Tham chiếu từ sheet Nhapkho chỉ cần phát sinh nhập kho 1 trong 2 loại hoặc cả 2 ( tem hộp hoặc tem treo )đều báo là nhập kho - ngược lại là chưa

Cột 12+13 : Tham chiếu từ sheet Nhapkho đúng đơn hàng/mã hàng/màu thì hiển thị ngày nhập kho

Cột 14 : Nếu cột 12 và 13 đều có ngày thì hiện là ok ngược lại chỉ nhập 1 trong 2 loại hoặc cả 2 chưa nhập thì hiện là chưa

Em có đính kèm file.
Mong nhận được sự giúp đỡ từ diễn đàn.
Em cảm ơn!

 

[snow25]

Em xin chào diễn đàn.
Hiện em đang có file theo giõi với chi tiết nhiều dữ liệu theo từng ngày phát sinh, cần sự giúp đỡ của diễn đàn để thưc hiện công việc được thuận lợi hơn ạ.
Với chi tiết yêu cầu :

Cột 11 : Tham chiếu từ sheet Nhapkho chỉ cần phát sinh nhập kho 1 trong 2 loại hoặc cả 2 ( tem hộp hoặc tem treo )đều báo là nhập kho - ngược lại là chưa

Cột 12+13 : Tham chiếu từ sheet Nhapkho đúng đơn hàng/mã hàng/màu thì hiển thị ngày nhập kho

Cột 14 : Nếu cột 12 và 13 đều có ngày thì hiện là ok ngược lại chỉ nhập 1 trong 2 loại hoặc cả 2 chưa nhập thì hiện là chưa

Em có đính kèm file.
Mong nhận được sự giúp đỡ từ diễn đàn.
Em cảm ơn!

Thử code.

Sub laygiatri()
   Dim i As Long, lr As Long, dic As Object, arr, kq, dk As String, data, T
   Set dic = CreateObject("scripting.dictionary")
   With Sheets("Nhapkho")
        lr = .Range("D" & Rows.Count).End(xlUp).Row
        data = .Range("D5:I" & lr).Value
        For i = 1 To UBound(data)
            dk = data(i, 4) & "#" & data(i, 5) & "#" & data(i, 6)
            If Not dic.exists(dk) Then
               dic.Add dk, i
            Else
               dic.Item(dk) = dic.Item(dk) & "#" & i
            End If
        Next i
  End With
  With Sheets("xuatkho")
       lr = .Range("D" & Rows.Count).End(xlUp).Row
       arr = .Range("D5:I" & lr).Value
       ReDim kq(1 To UBound(arr), 1 To 4)
       For i = 1 To UBound(arr)
           dk = arr(i, 3) & "#" & arr(i, 4) & "#" & arr(i, 5)
           If dic.exists(dk) Then
              kq(i, 1) = "Nhap kho"
              For Each T In Split(dic.Item(dk), "#")
                  If data(T, 2) = "Tem treo" Then
                     kq(i, 3) = data(T, 1)
                  Else
                     kq(i, 2) = data(T, 1)
                  End If
              Next T
              If Len(kq(i, 2)) And Len(kq(i, 2)) Then
                 kq(i, 4) = "Ok"
              Else
                 kq(i, 4) = "Chua"
              End If
         Else
            kq(i, 1) = "Chua"
            kq(i, 4) = "Chua"
         End If
     Next i
     .Range("K5:N" & lr).Value = kq
 End With
 Set dic = Nothing
End Sub

 

[soledad_90]

Thử code.

Sub laygiatri()
   Dim i As Long, lr As Long, dic As Object, arr, kq, dk As String, data, T
   Set dic = CreateObject("scripting.dictionary")
   With Sheets("Nhapkho")
        lr = .Range("D" & Rows.Count).End(xlUp).Row
        data = .Range("D5:I" & lr).Value
        For i = 1 To UBound(data)
            dk = data(i, 4) & "#" & data(i, 5) & "#" & data(i, 6)
            If Not dic.exists(dk) Then
               dic.Add dk, i
            Else
               dic.Item(dk) = dic.Item(dk) & "#" & i
            End If
        Next i
  End With
  With Sheets("xuatkho")
       lr = .Range("D" & Rows.Count).End(xlUp).Row
       arr = .Range("D5:I" & lr).Value
       ReDim kq(1 To UBound(arr), 1 To 4)
       For i = 1 To UBound(arr)
           dk = arr(i, 3) & "#" & arr(i, 4) & "#" & arr(i, 5)
           If dic.exists(dk) Then
              kq(i, 1) = "Nhap kho"
              For Each T In Split(dic.Item(dk), "#")
                  If data(T, 2) = "Tem treo" Then
                     kq(i, 3) = data(T, 1)
                  Else
                     kq(i, 2) = data(T, 1)
                  End If
              Next T
              If Len(kq(i, 2)) And Len(kq(i, 2)) Then
                 kq(i, 4) = "Ok"
              Else
                 kq(i, 4) = "Chua"
              End If
         Else
            kq(i, 1) = "Chua"
            kq(i, 4) = "Chua"
         End If
     Next i
     .Range("K5:N" & lr).Value = kq
 End With
 Set dic = Nothing
End Sub

Em cảm ơn anh nhiều . Kết quả hiển thị đúng rồi
Em xin điều chỉnh thêm .
Với sheet Nhapkho có thêm loại vật tư : Thẻ A/ Thẻ B v.v....
Code sẽ cần chỉnh thêm như nào để tại sheet Xuatkho sẽ thể hiện ngày giống như Tem hộp / tem treo ạ. Và có cột động bộ nữa ạ, khi tất cả các cột đều có ngày nhập
Em cảm ơn anh nhiều ạ.

 

[soledad_90]

Khi em chạy thêm các ngày thì kết quả đang hiển thị chưa đúng : tại dòng số 58 và 107
Khi chỉ có ngày nhập của tem hộp ( tem treo chưa nhập ) nhưng tại cột đồng bộ vẫn báo OK
Anh kiểm tra dùm e với ạ
Em cảm ơn!