Bạn thử với:Em chào các anh, các chị trên GPE
Em cần tách chuỗi trong các ô thành các dòng và copy sang sheet khác
Mọi chi tiết em đã trình bày trong file
Xin gửi kèm file mong mọi người giúp đỡ
Sub abc()
Dim c As Range, a
Dim LR%, i%, j%
LR = Sheets("Tong hop").Range("B" & Rows.Count).End(3).Row
i = 3
With Sheets("Tong hop")
For Each c In Range("B3:B" & LR)
a = Split(c.Offset(0, 5).Value, ";")
For j = 0 To UBound(a)
Range("L" & j + i).Value = c.Value
Range("M" & j + i).Value = c.Offset(0, 1).Value
Range("N" & j + i).Value = c.Offset(0, 2).Value
Range("O" & j + i).Value = c.Offset(0, 3).Value
Range("P" & j + i).Value = c.Offset(0, 4).Value
Range("Q" & j + i).Value = Trim(a(j))
Range("R" & j + i).Value = c.Offset(0, 6).Value
Range("S" & j + i).Value = c.Offset(0, 7).Value
Range("T" & j + i).Value = c.Offset(0, 8).Value
Next j
i = i + j
Next
End With
End SubSub abc_New()
Dim a, i%, j%, k&, Sp
a = Range("B3:J13").Value
k = 2
Application.ScreenUpdating = False
With Sheets("Sheet1")
For i = 1 To UBound(a, 1)
Sp = Split(a(i, 6), ";")
For j = 0 To UBound(Sp)
.Cells(k, 1) = a(i, 1)
.Cells(k, 2) = a(i, 2)
.Cells(k, 3) = a(i, 3)
.Cells(k, 4) = a(i, 4)
.Cells(k, 5) = a(i, 5)
.Cells(k, 6) = Sp(j)
.Cells(k, 7) = a(i, 7)
.Cells(k, 8) = a(i, 8)
.Cells(k, 9) = a(i, 9)
k = k + 1
Next
Next
End With
Application.ScreenUpdating = True
End SubCảm ơn bạn đã giúp đỡ.
Bạn đứng tại Sheets("Tong hop") và bấm nút( Hình mặt cười) rồi xem kết quả nhé.
chạy thử codeEm chào các anh, các chị trên GPE
Em cần tách chuỗi trong các ô thành các dòng và copy sang sheet khác
Mọi chi tiết em đã trình bày trong file
Xin gửi kèm file mong mọi người giúp đỡ
Sub GPE()
Dim Darr As Variant, Arr As Variant, Spl As Variant, i, j, k
Darr = Sheets("Tong hop").Range("B3:J" & Sheets("Tong hop").Range("B" & Rows.Count).End(xlUp).Row).Value
ReDim Arr(1 To 100000, 1 To UBound(Darr, 2))
For i = 1 To UBound(Darr, 1)
If Darr(i, 6) <> "" Then
Spl = Split(Replace(Darr(i, 6), Chr(10), ""), ";")
For s = 0 To UBound(Spl)
k = k + 1
For j = 1 To UBound(Darr, 2)
If j = 6 Then Arr(k, 6) = Spl(s) Else Arr(k, j) = Darr(i, j)
Next j
Next
End If
Next
Sheets("Sheet1").Range("A2").Resize(k, 9) = Arr
End Subđúng là hình mặt cười. Kết quả đúng như mình mong muốn
