Tách dữ liệu trong 01 ô (dòng) ra thành nhiều dòng! (4 người xem)

[bùi thị hòa]

Tôi không hiểu bạn nói gì cả!
Có trục trặc gì cứ đưa file lên đây! Mô tả khó hiểu quá!

Bài đã được tự động gộp: 2/10/18

ah, thì ra thế, sao tự dưng nghĩ thêm việc vào người vậy?

tức là muốn kết quả là A7:E18 từ dữ liệu A2:E5,
Vậy thì công thức sẽ phụ thuộc vào cột A, và khó là lập công thức cho cột A

Bạn xem file gửi kèm

Anh ơi, nhờ anh gom hộ e hai sheet trong file trên vào 1 sheet được không ạ? E cảm ơn anh nhiều

 

[Phuocam]

Anh ơi, nhờ anh gom hộ e hai sheet trong file trên vào 1 sheet được không ạ? E cảm ơn anh nhiều

Thử code này:

Option Explicit
Public Sub abc()
Dim tempArr As Variant, k As Long, i As Long, LastRow As Long
With Sheets("Source")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For i = LastRow To 2 Step -1
        If InStr(.Range("A" & i).Value, ";") > 0 Then
                tempArr = Split(.Range("A" & i).Value, ";")
                k = UBound(tempArr)
                .Rows(i).Offset(1).Resize(k).Insert
                .Rows(i).Offset(1).Resize(k).Value = .Rows(i).Value
                .Range("A" & i).Resize(k + 1).Value = Application.WorksheetFunction.Transpose(tempArr)
        End If
Next i
End With
End Sub

 

[linhvet0311]

Cầu các cao nhân giúp e tách dòng file này mới, em gà mờ nếu có công thức thì tốt. Em cảm ơn trước ạ

 

[befaint]

Em cảm ơn trước

1. Nếu có ai làm giúp bạn thì bạn cám ơn tiếp không?
2. Nếu không có ai làm giúp bạn thì bạn có rút lại không?
3. Hay như nào ngoài 1 và 2 ở trên?

 

[linhvet0311]

1. Nếu có ai làm giúp bạn thì bạn cám ơn tiếp không?
2. Nếu không có ai làm giúp bạn thì bạn có rút lại không?
3. Hay như nào ngoài 1 và 2 ở trên?

Em đăng lên đây là muốn tìm cao nhân giúp vì kiến thức excel của e hạn hẹp, nhưng bác lại soi từng câu chữ thế này để làm gì nhỉ?

 

[Ba Tê]

Em đăng lên đây là muốn tìm cao nhân giúp vì kiến thức excel của e hạn hẹp, nhưng bác lại soi từng câu chữ thế này để làm gì nhỉ?

Phải "soi" để đáp ứng yêu cầu của bạn chứ.
Bạn cầu "cao nhân" nên những người không phải "cao nhân" phải xem kỹ kẻo bị bảo là "ham hố" thành cao nhân.
Câu này là hỏi cho rõ nè:

1. Nếu có ai làm giúp bạn thì bạn cám ơn tiếp không?

 

[huuthang_bd]

Em đăng lên đây là muốn tìm cao nhân giúp vì kiến thức excel của e hạn hẹp, nhưng bác lại soi từng câu chữ thế này để làm gì nhỉ?

Nhờ bài soi đó mới biết bạn cũng không quan tâm đến câu trả lời. Anh em đỡ tốn công.
(Thường phản hồi sau 10 ngày )

 

[khi ta 20]

Em đăng lên đây là muốn tìm cao nhân giúp vì kiến thức excel của e hạn hẹp, nhưng bác lại soi từng câu chữ thế này để làm gì nhỉ?

Hí hí, bạn bỏ mấy từ cao nhân gì gì đó đi. Nghe thấy ngại và nhột lắm.
Sửa đi thì sẽ có kết quả ngay, còn không thì chờ ... 2019 !

 

[Loc Uyen]

Hí hí, bạn bỏ mấy từ cao nhân gì gì đó đi. Nghe thấy ngại và nhột lắm.
Sửa đi thì sẽ có kết quả ngay, còn không thì chờ ... 2019 !

Có nên thêm vào nội quy diễn đàn không nhỉ?

 

[AnhNQT]

Nhờ các anh xem giúp!
Em cần xin VBA hoạt động như file mẫu đính kèm.

 

[manhkhang214]

Em chào các anh chị trong group.Em có 1 file sửa hàng mà bjo bên nhà cung cấp yêu cầu tách các lỗi ở cột H ra từng dòng riêng biệt,Anh chị có cách nào chỉ giúp em với ak.Em cảm ơn rất rất nhiều ak.

 

[snow25]

Em chào các anh chị trong group.Em có 1 file sửa hàng mà bjo bên nhà cung cấp yêu cầu tách các lỗi ở cột H ra từng dòng riêng biệt,Anh chị có cách nào chỉ giúp em với ak.Em cảm ơn rất rất nhiều ak.

Bạn chạy xem có đúng không nhé.

Sub tachloi()
   Dim arr, arr1, lr As Long, i As Long, j As Long, a As Long, T
   With Sheets("Detail (2)")
        lr = .Range("H" & Rows.Count).End(xlUp).Row
        If lr < 6 Then Exit Sub
        arr = .Range("B6:K" & lr).Value
        ReDim arr1(1 To UBound(arr, 1) * 4, 1 To UBound(arr, 2))
   End With
        For i = 1 To UBound(arr, 1)
            For Each T In Split(arr(i, 7), ",")
                a = a + 1
                For j = 2 To UBound(arr, 2)
                    arr1(a, j) = arr(i, j)
                Next j
                    arr1(a, 8) = T
                    arr1(a, 1) = a
           Next
       Next
   With Sheets("ket qua")
        lr = .Range("H" & Rows.Count).End(xlUp).Row
        If lr > 5 Then .Range("B6:K" & lr).ClearContents
        .Range("b6").Resize(a, UBound(arr, 2)).Value = arr1
   End With
End Sub

 

[manhkhang214]

Em muốn tách mỗi lỗi ở cột G thành từng dòng 1 những dữ liệu còn lại vẫn giữ nguyên ý ad ak??

 

[snow25]

Em muốn tách mỗi lỗi ở cột G thành từng dòng 1 những dữ liệu còn lại vẫn giữ nguyên ý ad ak??

Cho cái ví dụ xem nào bạn.

 

[manhkhang214]

Ad check lại giúp em nhé

 

[snow25]

Ad check lại giúp em nhé

Đây bạn xem.

 

[nguyensatran]

Nhờ các Anh/chị giúp em tách từ 1 dòng thành nhiều dòng như file đính kèm với ạ. Bài của em hoàn toàn khác với vấn đề mà mọi người đã giải đáp ở trên nên em không áp dụng được. Nếu có thể giúp em tách theo 2 cách em đã làm thủ công ở 2 sheet kế bên.
Xin cám ơn nhiều

 

[snow25]

Nhờ các Anh/chị giúp em tách từ 1 dòng thành nhiều dòng như file đính kèm với ạ. Bài của em hoàn toàn khác với vấn đề mà mọi người đã giải đáp ở trên nên em không áp dụng được. Nếu có thể giúp em tách theo 2 cách em đã làm thủ công ở 2 sheet kế bên.
Xin cám ơn nhiều

Dữ liệu của bạn không đồng nhất 2 cột mà cũng không phải là chia theo xuống dòng.Bạn xem lại nhé.Còn code mình viết đây.

Sub tach()
    Dim arr, i As Long, lr As Long, T, kq, a As Long, R As Long, L As Long, T1, k As Integer, j As Integer
    With Sheets("nguon")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr = 1 Then Exit Sub
         arr = .Range("B5:O" & lr).Value
         R = UBound(arr)
         L = UBound(arr, 2)
         If R * 10 > Rows.Count Then a = Rows.Count Else a = R * 10
         ReDim kq(1 To a, 1 To L)
         a = 0
    End With
        For i = 1 To R
            T = Split(Chr(10) & arr(i, 9), Chr(10))
           ' T1 = Split(Chr(10) & arr(i, 10), Chr(10))
            For k = 1 To UBound(T)
                If Len(T(k)) > 0 Then
                   a = a + 1
                   For j = 1 To L
                       kq(a, j) = arr(i, j)
                   Next j
                        kq(a, 9) = T(k)
                        'kq(a, 10) = T1(k)
                End If
            Next k
       Next i
    With Sheets("cach2")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr > 4 Then .Range("B5:O" & lr).ClearContents
         If a Then .Range("B5:o5").Resize(a).Value = kq
    End With
End Sub

 

[phulien1902]

Trong File của bạn thiếu Next k

 

[snow25]

Trong File của bạn thiếu Next k

Em đã sửa file chắc do lúc em tải lên chưa lưu lại.Code bài đăng có mà.