Chia giá trị 1 ô thành nhiều hàng và các giá trị tương ứng

[janenguyen1111]

Em chào các bác ạ.
Em muốn dùng hàm để tách giá trị ở cột D thành các hàng và đi kèm các giá trị tương ứng như bảng bên dưới.
Rất mong được sự trợ giúp từ các bác.

 

[Nhattanktnn]

Em chào các bác ạ.
Em muốn dùng hàm để tách giá trị ở cột D thành các hàng và đi kèm các giá trị tương ứng như bảng bên dưới.
Rất mong được sự trợ giúp từ các bác.

Cái này vba thì còn được chứ công thức nhức não lắm

 

[HUONGHCKT]

Em chào các bác ạ.
Em muốn dùng hàm để tách giá trị ở cột D thành các hàng và đi kèm các giá trị tương ứng như bảng bên dưới.
Rất mong được sự trợ giúp từ các bác.

Bạn dùng thử code này, thêm dữ liệu vào chạy thử, kết quả trả về nằm ở L4 trở đi.
Dữ liệu cột D của bạn không biêt được nhập vào kiểu gì nữa? Tôi đã sửa. Đây là theo dữ liệu của bạn nếu dữ liệu cột D có cả chuỗi và các dấu"," ".", "/" ,... thì phải sửa lại code.

 

[janenguyen1111]

Bạn dùng thử code này, thêm dữ liệu vào chạy thử, kết quả trả về nằm ở L4 trở đi.
Dữ liệu cột D của bạn không biêt được nhập vào kiểu gì nữa? Tôi đã sửa. Đây là theo dữ liệu của bạn nếu dữ liệu cột D có cả chuỗi và các dấu"," ".", "/" ,... thì phải sửa lại code.

cột 4 không phải chuỗi và các dấu mà là các giá trị gồm nhiều dãy số khác nhau, cách nhau bởi việc xuống dòng bác ạ.
Em gửi bác link gdocs các bác check giúp em: Liên kết: https://docs.google.com/spreadsheets/d/1e44TeWf2f7vxiYpvyF90_YWJU2Nv5FcHXsxJnHmaGps/edit#gid=0 Liên kết: https://docs.google.com/spreadsheets/d/1e44TeWf2f7vxiYpvyF90_YWJU2Nv5FcHXsxJnHmaGps/edit?usp=sharing

 

[befaint]

 Liên kết: https://docs.google.com/spreadsheets/d/1e44TeWf2f7vxiYpvyF90_YWJU2Nv5FcHXsxJnHmaGps/edit?usp=sharing

Đây là Google Sheets mà. Một thế giới khác với Excel rồi.

 

[HUONGHCKT]

cột 4 không phải chuỗi và các dấu mà là các giá trị gồm nhiều dãy số khác nhau, cách nhau bởi việc xuống dòng bác ạ.
Em gửi bác link gdocs các bác check giúp em: Liên kết: https://docs.google.com/spreadsheets/d/1e44TeWf2f7vxiYpvyF90_YWJU2Nv5FcHXsxJnHmaGps/edit#gid=0 Liên kết: https://docs.google.com/spreadsheets/d/1e44TeWf2f7vxiYpvyF90_YWJU2Nv5FcHXsxJnHmaGps/edit?usp=sharing

Nếu là Excel thì
1/Bạn tham khảo code này của anh SA_DQ- Hoàn toàn giải quyết được yêu cầu của bạn cho dù dữ liệu nhiều dòng, nhiều cột.

Function SplitRow(ByVal aArr As Variant, ByVal lMainCol As Long, sDelemiter As String) As Variant
Dim i As Long, j As Long, ii As Long, k As Long, aResult As Variant, lCount As Long
'aArr = aArr
For i = LBound(aArr, 1) To UBound(aArr, 1)
aArr(i, lMainCol) = Split(aArr(i, lMainCol), sDelemiter)
k = UBound(aArr(i, lMainCol), 1) - LBound(aArr(i, lMainCol), 1) + 1
lCount = lCount + k
For j = LBound(aArr, 2) To UBound(aArr, 2)
If j <> lMainCol Then
aArr(i, j) = Split(Replace(Space(k), " ", aArr(i, j) & sDelemiter), sDelemiter, k + 1)
End If
Next
Next
ReDim aResult(1 To lCount, LBound(aArr, 2) To UBound(aArr, 2))
k = 0
For i = LBound(aArr, 1) To UBound(aArr, 1)
For ii = LBound(aArr(i, lMainCol), 1) To UBound(aArr(i, lMainCol), 1)
k = k + 1
For j = LBound(aArr, 2) To UBound(aArr, 2)
aResult(k, j) = aArr(i, j)(ii)
Next
Next
Next
SplitRow = aResult
End Function

Sub Test()
Arr = SplitRow(Sheet1.[A4:F8].Value, 4, ChrW(10))
Sheet1.[A14].Resize(UBound(Arr, 1), UBound(Arr, 2)).Value = Arr
End Sub

2/ Bổ sung Thêm dữ liệu vào Sh1 và thay thế các chỗ bôi đen cho phù hợp và chạy thử.
3/ Hãy gửi lời cảm ơn đến BQT diễn đàn và cá nhân anh SA_DQ nhé!
Chúc thành công.

 

[janenguyen1111]

Nếu là Excel thì
1/Bạn tham khảo code này của anh SQ_DA- Hoàn toàn giải quyết được yêu cầu của bạn cho dù dữ liệu nhiều dòng, nhiều cột.

Function SplitRow(ByVal aArr As Variant, ByVal lMainCol As Long, sDelemiter As String) As Variant
Dim i As Long, j As Long, ii As Long, k As Long, aResult As Variant, lCount As Long
'aArr = aArr
For i = LBound(aArr, 1) To UBound(aArr, 1)
aArr(i, lMainCol) = Split(aArr(i, lMainCol), sDelemiter)
k = UBound(aArr(i, lMainCol), 1) - LBound(aArr(i, lMainCol), 1) + 1
lCount = lCount + k
For j = LBound(aArr, 2) To UBound(aArr, 2)
If j <> lMainCol Then
aArr(i, j) = Split(Replace(Space(k), " ", aArr(i, j) & sDelemiter), sDelemiter, k + 1)
End If
Next
Next
ReDim aResult(1 To lCount, LBound(aArr, 2) To UBound(aArr, 2))
k = 0
For i = LBound(aArr, 1) To UBound(aArr, 1)
For ii = LBound(aArr(i, lMainCol), 1) To UBound(aArr(i, lMainCol), 1)
k = k + 1
For j = LBound(aArr, 2) To UBound(aArr, 2)
aResult(k, j) = aArr(i, j)(ii)
Next
Next
Next
SplitRow = aResult
End Function

Sub Test()
Arr = SplitRow(Sheet1.[A4:F8].Value, 4, ChrW(10))
Sheet1.[A14].Resize(UBound(Arr, 1), UBound(Arr, 2)).Value = Arr
End Sub

2/ Bổ sung Thêm dữ liệu vào Sh1 và thay thế các chỗ bôi đen cho phù hợp và chạy thử.
3/ Hãy gửi lời cảm ơn đến BQT diễn đàn và cá nhân anh SQ_DQ nhé!
Chúc thành công.

Em cảm ơn bác HUONGHCKT và anh SQ DQ nhiều đã giúp em.
Ngoài cách trên em cũng mới được chỉ thêm một cách dùng query trên Excel như video bên dưới. Mong là giúp ích được thêm các bác trong diễn đàn gặp phải tình trạng giống em mà không biết VBA:

Liên kết: https://www.youtube.com/watch?v=nGygtOutMtg