Thêm dòng và copy dữ liệu theo điều kiện

[topgun]

chào các bác,
mình có 1 dữ liệu gốc (sheet dữ liệu ban đầu), muốn thay đổi dữ liệu theo định dạng ở sheet dữ liệu mong muốn. Điều kiện, ví dụ là: nếu cột B có giá trị là 4 thì sẽ chèn thêm 3 dòng tiếp theo, và copy dữ liệu từ cột D sang cột C giống như sheet dữ liệu mong muốn.Nhờ các bác giúp. Cám ơn các bác!

 

[concogia]

chào các bác,
mình có 1 dữ liệu gốc (sheet dữ liệu ban đầu), muốn thay đổi dữ liệu theo định dạng ở sheet dữ liệu mong muốn. Điều kiện, ví dụ là: nếu cột B có giá trị là 4 thì sẽ chèn thêm 3 dòng tiếp theo, và copy dữ liệu từ cột D sang cột C giống như sheet dữ liệu mong muốn.Nhờ các bác giúp. Cám ơn các bác!

Thử đại cái này xem, biết đâu trúng

Private Sub Worksheet_Activate()
    Dim Vung As Range, Tam, Cll As Range, Ws
    Set Ws = Sheets("du lieu ban dau")
    Set Vung = Ws.Range(Ws.[d2], Ws.[d100].End(xlUp))
        [f2:i100].ClearContents
            For Each Cll In Vung
                Tam = Tam & Cll.Offset(, -1) & " " & Cll & " "
                    With [f100].End(xlUp)(2)
                        .Resize(Cll.Offset(, -2)) = Cll.Offset(, -3)
                        .Offset(, 1) = Cll.Offset(, -2)
                        .Offset(, 3) = Cll
                    End With
            Next
                Tam = Replace(Tam, "   ", " ")
                Tam = Split(Tam, " ")
                [h2].Resize(UBound(Tam)) = Application.WorksheetFunction.Transpose(Tam)
End Sub

Nhớ nhập đúng địng dạng của bạn ở cột D nhé
Nhập dữ liệu ở sheet "du lieu ban dau" xong sang sheet "du lieu mong muon" xem kết quả

 

[ChanhTQ@]

Thêm 1 tham khảo cho bạn, hi, hi,. . .

Option Explicit
Sub AddRows()
 Dim Cls As Range, Rng As Range
 Dim WF, Temp, Rws As Long, Jj As Long
 
 ThisWorkbook.Worksheets("Data").Select
 Set WF = Application.WorksheetFunction
 Rws = [b1].CurrentRegion.Rows.Count
 For Jj = Rws To 2 Step -1
    Set Cls = Cells(Jj, "B")
    Temp = Split(Cls.Offset(, 2).Value, "  ")
    Set Rng = Cls.Offset(1).Resize(Cls.Value - 1)
    If Jj < Rws Then
        Rng.EntireRow.Insert
        Rng.Offset(1 - Cls.Value, -1).Value = Cls.Offset(, -1).Value
        Rng.Offset(1 - Cls.Value, 1).Value = WF.Transpose(Temp)
    Else
        Rng.Offset(, -1).Value = Cls.Offset(, -1).Value
        Rng.Offset(, 1).Value = WF.Transpose(Temp)
    End If
 Next Jj
End Sub