Kính nhờ Anh, Chị viết code cho chạy các dòng từ Sheet qua Sheet

[chuotpt3]

Dạ, em có file ViDu này, kính nhờ các Anh, Chị code giúp để có thể chạy các dòng heading, group và công việc từ Sheet All-Action-Plan qua Sheet Monthly-Plan với điều kiện:
* Công việc xuất hiện trong Sheet All-Action-Plan (khác rỗng, hoặc = B, hoặc = Đ, hoặc = K) trong cell nào của Tháng X đó thì chép qua Sheet Monthly-Plan theo thứ tự: Heading→ Group→ Công việc– và nếu cùng Group thì các công việcđược xuất hiện theo group và heading ạ

Em đã ví dụ trong Sheet Monthly-Plan đây ạ.
Em mong tin các Anh, Chị lắm
Em chuotpt3

 

[keyeutien]

Bạn dùng từ ngữ trang trọng quá làm người giúp cảm giác sắp được thăng thiên

 

[PacificPR]

Dạ, em có file ViDu này, kính nhờ các Anh, Chị code giúp để có thể chạy các dòng heading, group và công việc từ Sheet All-Action-Plan qua Sheet Monthly-Plan với điều kiện:
* Công việc xuất hiện trong Sheet All-Action-Plan (khác rỗng, hoặc = B, hoặc = Đ, hoặc = K) trong cell nào của Tháng X đó thì chép qua Sheet Monthly-Plan theo thứ tự: Heading→ Group→ Công việc– và nếu cùng Group thì các công việcđược xuất hiện theo group và heading ạ

Em đã ví dụ trong Sheet Monthly-Plan đây ạ.
Em mong tin các Anh, Chị lắm
Em chuotpt3

Bạn tham khảo

 

[chuotpt3]

Dạ, chân thành cảm ơn bạn PacificPR lắm lắm ạ –
Nhưng khi Run thì các Group 1, 2 của Heading 1 không hiển thị ạ – và Tháng 6/2021 vẫn có các công việc để kết thúc (K) mà không thấy được liệt kê ấy bạn PacificPR – Vậy mến nhờ bạn giúp với ạ – các công việc K cũng bắt buộc phải có trong các list công việc được hiển thị ra trong Monthly-Plan ạ.

Chân thành cảm ơn bạn vô vàn và mong tin bạn lắm!!!

Bài đã được tự động gộp: 17/4/20

Bạn dùng từ ngữ trang trọng quá làm người giúp cảm giác sắp được thăng thiên

Dạ, mình được dạy như thế – biết làm sao được ạ – dù tính tình có hơi gấu chút đấy ...

 

[PacificPR]

Nhưng khi Run thì các Group 1, 2 của Heading 1 không hiển thị ạ – và Tháng 6/2021 vẫn có các công việc để kết thúc (K) mà không thấy được liệt kê

Bạn kiểm tra lại xem sao

 

[HieuCD]

Dạ, em có file ViDu này, kính nhờ các Anh, Chị code giúp để có thể chạy các dòng heading, group và công việc từ Sheet All-Action-Plan qua Sheet Monthly-Plan với điều kiện:
* Công việc xuất hiện trong Sheet All-Action-Plan (khác rỗng, hoặc = B, hoặc = Đ, hoặc = K) trong cell nào của Tháng X đó thì chép qua Sheet Monthly-Plan theo thứ tự: Heading→ Group→ Công việc– và nếu cùng Group thì các công việcđược xuất hiện theo group và heading ạ

Em đã ví dụ trong Sheet Monthly-Plan đây ạ.
Em mong tin các Anh, Chị lắm
Em chuotpt3

Rảnh rổi quá viết thử code

Sub XYZ()
  Dim sArr(), Res()
  Dim sRow&, sCol&, i&, j&, j2&, k&, fCol&, eCol&
  Dim Thang$, Heading$, Group$
 
  With Sheets("All-Action-Plan")
    i = .Range("C" & Rows.Count).End(xlUp).Row
    sArr = .Range("B2:BD" & i).Value
  End With
  sRow = UBound(sArr): sCol = UBound(sArr, 2) - 1
  ReDim Res(1 To 2000, 1 To 4)
 
  For j = 3 To sCol
    fCol = j
    Thang = sArr(1, fCol)
    For j2 = fCol To sCol
      If sArr(1, j2 + 1) <> Empty Then
        eCol = j2:    Exit For
      End If
    Next j2
    For i = 3 To UBound(sArr)
      If sArr(i, 1) <> Empty And sArr(i, 2) = Empty Then Heading = sArr(i, 1)
      If sArr(i, 1) <> Empty And sArr(i, 2) <> Empty Then Group = sArr(i, 1)
      If sArr(i, 2) <> Empty Then
        For j2 = fCol To eCol
          If sArr(i, j2) <> Empty Then
            If Heading <> Empty Then
              k = k + 1: Res(k, 2) = Heading: Heading = Empty
              If Thang <> Empty Then Res(k, 1) = Thang: Thang = Empty
            End If
            If Group <> Empty Then
              k = k + 1:  Res(k, 3) = Group:        Group = Empty
            End If
            k = k + 1:    Res(k, 4) = sArr(i, 2):   Exit For
          End If
        Next j2
      End If
    Next i
    j = eCol
  Next j
  With Sheets("Monthly-Plan")
    .Range("F5:I1000").ClearContents
    If k Then .Range("F5").Resize(k, 4) = Res
  End With
End Sub

 

[chuotpt3]

Bạn kiểm tra lại xem sao

Dạ, đúng quá đúng ý rồi ạ
Chân thành đa tạ bạn PacificPR vô vàn!!!

Bài đã được tự động gộp: 17/4/20

Rảnh rổi quá viết thử code

Sub XYZ()
  Dim sArr(), Res()
  Dim sRow&, sCol&, i&, j&, j2&, k&, fCol&, eCol&
  Dim Thang$, Heading$, Group$

  With Sheets("All-Action-Plan")
    i = .Range("C" & Rows.Count).End(xlUp).Row
    sArr = .Range("B2:BD" & i).Value
  End With
  sRow = UBound(sArr): sCol = UBound(sArr, 2) - 1
  ReDim Res(1 To 2000, 1 To 4)

  For j = 3 To sCol
    fCol = j
    Thang = sArr(1, fCol)
    For j2 = fCol To sCol
      If sArr(1, j2 + 1) <> Empty Then
        eCol = j2:    Exit For
      End If
    Next j2
    For i = 3 To UBound(sArr)
      If sArr(i, 1) <> Empty And sArr(i, 2) = Empty Then Heading = sArr(i, 1)
      If sArr(i, 1) <> Empty And sArr(i, 2) <> Empty Then Group = sArr(i, 1)
      If sArr(i, 2) <> Empty Then
        For j2 = fCol To eCol
          If sArr(i, j2) <> Empty Then
            If Heading <> Empty Then
              k = k + 1: Res(k, 2) = Heading: Heading = Empty
              If Thang <> Empty Then Res(k, 1) = Thang: Thang = Empty
            End If
            If Group <> Empty Then
              k = k + 1:  Res(k, 3) = Group:        Group = Empty
            End If
            k = k + 1:    Res(k, 4) = sArr(i, 2):   Exit For
          End If
        Next j2
      End If
    Next i
    j = eCol
  Next j
  With Sheets("Monthly-Plan")
    .Range("F5:I1000").ClearContents
    If k Then .Range("F5").Resize(k, 4) = Res
  End With
End Sub

Dạ, mình cảm ơn chân thành.
Để mình paste code giữ lại ạ