Liệt kê nội dung theo mã công việc

[mobile7]

Em có 1 file như thế này

Trong đó sheet danh mục gồm chi tiết các công việc phát sinh với các cửa hàng và khách hàng, tương ứng với ngày, mã việc và các nội dung khác
Có ngày bắt đầu và ngày kết thúc ở phía trên

Sheet1 cần tổng hợp các nội dung tại sheet danh mục
Theo đó, chỉ liệt kê các mã việc có trạng thái là "Dang thuc hien" trong thời gian cho trước, và liệt kê nội dung gần nhất của mã việc đó (không liệt kê tất cả)

Các bác chỉ em với nhé

 

[PacificPR]

Em có 1 file như thế này

Trong đó sheet danh mục gồm chi tiết các công việc phát sinh với các cửa hàng và khách hàng, tương ứng với ngày, mã việc và các nội dung khác
Có ngày bắt đầu và ngày kết thúc ở phía trên

Sheet1 cần tổng hợp các nội dung tại sheet danh mục
Theo đó, chỉ liệt kê các mã việc có trạng thái là "Dang thuc hien" trong thời gian cho trước, và liệt kê nội dung gần nhất của mã việc đó (không liệt kê tất cả)

Các bác chỉ em với nhé

Bạn tham khảo thử

 

[mobile7]

Bác ơi chỉ liệt kê các mã việc và nội dung có trạng thái Dang thuc hien thôi được k ạ (Hoan thanh thì thôi). Với cả chỉ liệt kê mã việc và nội dung gần nhất thôi (không liệt kê tất cả)

 

[mobile7]

Up

 

[be_09]

Em có 1 file như thế này

Trong đó sheet danh mục gồm chi tiết các công việc phát sinh với các cửa hàng và khách hàng, tương ứng với ngày, mã việc và các nội dung khác
Có ngày bắt đầu và ngày kết thúc ở phía trên

Sheet1 cần tổng hợp các nội dung tại sheet danh mục
Theo đó, chỉ liệt kê các mã việc có trạng thái là "Dang thuc hien" trong thời gian cho trước, và liệt kê nội dung gần nhất của mã việc đó (không liệt kê tất cả)

Các bác chỉ em với nhé

Do bạn không đưa vài kết quả vào Sheet1 nên chẳng ai hiểu.
Theo tôi thì làm vầy: Dùng 1 sheet lọc trạng thái "Dang thuc hien" theo nội dung cần, sau đó muốn xử lý kiểu gì thì ở sheet này.

 

[HieuCD]

Em có 1 file như thế này

Trong đó sheet danh mục gồm chi tiết các công việc phát sinh với các cửa hàng và khách hàng, tương ứng với ngày, mã việc và các nội dung khác
Có ngày bắt đầu và ngày kết thúc ở phía trên

Sheet1 cần tổng hợp các nội dung tại sheet danh mục
Theo đó, chỉ liệt kê các mã việc có trạng thái là "Dang thuc hien" trong thời gian cho trước, và liệt kê nội dung gần nhất của mã việc đó (không liệt kê tất cả)

Các bác chỉ em với nhé

Chạy code

Sub Lietke()
  Dim sArr(), Res(), i As Long, k As Long, MaViec As String
  Dim fDate As Date, eDate As Date
  Const TrangThai As String = "DANG THUC HIEN"
  With Sheets("Danh muc")
    fDate = .Range("B1").Value
    eDate = .Range("B2").Value
    sArr = .Range("A5", .Range("A" & Rows.Count).End(xlUp)).Resize(, 15).Value
  End With
  ReDim Res(1 To UBound(sArr), 1 To 7)
  With CreateObject("scripting.dictionary")
    For i = UBound(sArr) To 1 Step -1
      If sArr(i, 1) <= eDate Then
        If sArr(i, 1) >= fDate Then
          If UCase(sArr(i, 13)) = TrangThai Then
            MaViec = sArr(i, 10)
            If .exists(MaViec) = False Then
              .Add MaViec, ""
              sArr(i, 2) = "Bat Duoc Mi Roi, Ha Ha Ha"
            End If
          End If
        Else
          Exit For
        End If
      End If
    Next i
  End With
  For i = 1 To UBound(sArr)
    If sArr(i, 2) = "Bat Duoc Mi Roi, Ha Ha Ha" Then
      k = k + 1:                 Res(k, 1) = k
      Res(k, 2) = sArr(i, 5):    Res(k, 3) = sArr(i, 6)
      Res(k, 4) = sArr(i, 10):   Res(k, 5) = sArr(i, 11)
      Res(k, 6) = sArr(i, 14):   Res(k, 7) = sArr(i, 15)
    End If
  Next i
  With Sheets("Sheet1")
    .Range("A3:G5000").ClearContents
    If k Then .Range("A3").Resize(k, 7) = Res Else MsgBox "Nothing"
  End With
End Sub

 

[mobile7]

Hình như có lỗi bác HieuCD ạ, k liệt kê mã công việc BB-CH3

 

[HieuCD]

Hình như có lỗi bác HieuCD ạ, k liệt kê mã công việc BB-CH3

mã công việc BB-CH3 ngày 1/5/2019, nên liệt kê ở dòng đầu tiên

 

[mobile7]

Em kiểm tra lại nhiều lần, vẫn lỗi bác ạ. Với cả nếu cùng 1 code công việc, nếu đã Hoan thanh trong kỳ xét thì không liệt kê lại nữa, nhưng ở đây vẫn bị liệt kê ra

 

[HieuCD]

Em kiểm tra lại nhiều lần, vẫn lỗi bác ạ. Với cả nếu cùng 1 code công việc, nếu đã Hoan thanh trong kỳ xét thì không liệt kê lại nữa, nhưng ở đây vẫn bị liệt kê ra

Hiểu rồi, chỉnh lại code

Sub Lietke()
  Dim sArr(), Res(), i As Long, k As Long, MaViec As String
  Dim fDate As Date, eDate As Date
  Const htNO As String = "DANG THUC HIEN"
  Const htYes As String = "HOAN THANH"
  With Sheets("Danh muc")
    fDate = .Range("B1").Value
    eDate = .Range("B2").Value
    sArr = .Range("A5", .Range("A" & Rows.Count).End(xlUp)).Resize(, 15).Value
  End With
  ReDim Res(1 To UBound(sArr), 1 To 7)
  With CreateObject("scripting.dictionary")
    For i = UBound(sArr) To 1 Step -1
      MaViec = sArr(i, 10)
      If UCase(sArr(i, 13)) = htYes Then .item(MaViec)= ""
      If sArr(i, 1) <= eDate Then
        If sArr(i, 1) >= fDate Then
          If UCase(sArr(i, 13)) = htNO Then
            If .exists(MaViec) = False Then
              .Add MaViec, ""
              sArr(i, 2) = "Bat Duoc Mi Roi, Ha Ha Ha"
            End If
          End If
        Else
          Exit For
        End If
      End If
    Next i
  End With
  For i = 1 To UBound(sArr)
    If sArr(i, 2) = "Bat Duoc Mi Roi, Ha Ha Ha" Then
      k = k + 1:                 Res(k, 1) = k
      Res(k, 2) = sArr(i, 5):    Res(k, 3) = sArr(i, 6)
      Res(k, 4) = sArr(i, 10):   Res(k, 5) = sArr(i, 11)
      Res(k, 6) = sArr(i, 14):   Res(k, 7) = sArr(i, 15)
    End If
  Next i
  With Sheets("Sheet1")
    .Range("A3:G5000").ClearContents
    If k Then .Range("A3").Resize(k, 7) = Res Else MsgBox "Nothing"
  End With
End Sub

 

[mobile7]

Bác ơi nếu mã việc mà trùng nhau (mà các thông tin còn lại khác nhau) thì sẽ ra lỗi 457
"This key is already associated with an element of this collection"
Có cách gì sửa lỗi này không hay phải sửa dữ liệu

 

[HieuCD]

Bác ơi nếu mã việc mà trùng nhau (mà các thông tin còn lại khác nhau) thì sẽ ra lỗi 457
"This key is already associated with an element of this collection"
Có cách gì sửa lỗi này không hay phải sửa dữ liệu

Đã chỉnh lại code bài #10
If UCase(sArr(i, 13)) = htYes Then .item(MaViec)= ""

 

[mobile7]

Cám ơn bác HieuCD nhiều ạ!