[HỎI] TÁCH 1 DÒNG THÀNH NHIỀU DÒNG

[lightknight90]

Em đang cần tách dữ liệu từ 1 dòng thành nhiều dòng như file đi kèm. Cụ thể: các ngày trên 1 dòng cần chuyển xuống dòng dưới (mỗi ngày tương ứng 1 dòng), các ô khác tự động copy xuống. Mong được các cao thủ giúp đỡ.

 

[snow25]

Em đang cần tách dữ liệu từ 1 dòng thành nhiều dòng như file đi kèm. Cụ thể: các ngày trên 1 dòng cần chuyển xuống dòng dưới (mỗi ngày tương ứng 1 dòng), các ô khác tự động copy xuống. Mong được các cao thủ giúp đỡ.

Giải thích rõ xem nào bạn.Cái mà copy ra bao nhiêu dòng đó.

 

[lightknight90]

Giải thích rõ xem nào bạn.Cái mà copy ra bao nhiêu dòng đó.

Mình muốn chuyển các ô từ cột G trở về sau mỗi ô xuống 1 hàng nằm trong cột G (giá trị ngày). Còn các ô trước cột G thì giống nhau dòng trên copy xuống dòng dưới

 

[CHAOQUAY]

Em đang cần tách dữ liệu từ 1 dòng thành nhiều dòng như file đi kèm. Cụ thể: các ngày trên 1 dòng cần chuyển xuống dòng dưới (mỗi ngày tương ứng 1 dòng), các ô khác tự động copy xuống. Mong được các cao thủ giúp đỡ.

Bạn chạy thử code này xem sao. Kết quả điền tại sheet2

Sub TachDong()
Dim Nguon As Variant
Dim Kq() As Variant
Dim i, j, k, x, z, t
Nguon = Sheet1.Range("a2", Sheet1.Range("a2").End(xlDown)).Resize(, 37)
ReDim Kq(1 To UBound(Nguon) * 31 + 1, 1 To 7)
For j = 1 To 7
    Kq(1, j) = Sheet1.Cells(1, j).Value
Next j
k = 1
For i = 1 To UBound(Nguon)
    For j = 7 To UBound(Nguon, 2)
        If Nguon(i, j) = "" Then
            Exit For
        Else
            k = k + 1
            Kq(k, 7) = Nguon(i, j)
            For x = 1 To 6
                Kq(k, x) = Nguon(i, x)
            Next x
        End If
    Next j
Next i
With Sheet2
.UsedRange.ClearContents
.Range("a1").Resize(k, UBound(Kq, 2)) = Kq
.UsedRange.Columns.AutoFit
End With
End Sub

 

[lightknight90]

Bạn chạy thử code này xem sao. Kết quả điền tại sheet2

Sub TachDong()
Dim Nguon As Variant
Dim Kq() As Variant
Dim i, j, k, x, z, t
Nguon = Sheet1.Range("a2", Sheet1.Range("a2").End(xlDown)).Resize(, 37)
ReDim Kq(1 To UBound(Nguon) * 31 + 1, 1 To 7)
For j = 1 To 7
    Kq(1, j) = Sheet1.Cells(1, j).Value
Next j
k = 1
For i = 1 To UBound(Nguon)
    For j = 7 To UBound(Nguon, 2)
        If Nguon(i, j) = "" Then
            Exit For
        Else
            k = k + 1
            Kq(k, 7) = Nguon(i, j)
            For x = 1 To 6
                Kq(k, x) = Nguon(i, x)
            Next x
        End If
    Next j
Next i
With Sheet2
.UsedRange.ClearContents
.Range("a1").Resize(k, UBound(Kq, 2)) = Kq
.UsedRange.Columns.AutoFit
End With
End Sub

Bạn ơi có thể tổng quá hóa code trên phụ thuộc vào địa chỉ cột của active cell không? Ví dụ như mình đang ở ô nào đó của cột G, khi chạy code thì các cột sau cột G tự chuyển thành dòng ấy?