Phương pháp tách dữ liệu (1 người xem)

[hienasian]

Nhờ anh chị giải dùm bài này. Yêu cầu của bài này là tách dữ liệu của 1 ô thành 2 ô (như File đính kèm). Cảm ơn nhiều.

 

[Quang_Hải]

Nhờ anh chị giải dùm bài này. Yêu cầu của bài này là tách dữ liệu của 1 ô thành 2 ô (như File đính kèm). Cảm ơn nhiều.

Với 2 hàm này sẽ đáp ứng được yêu cầu của bạn. Copy code và dán vào 1 module

Tai 1 ô nào đó nhập = tachdau(B2) sẽ được phần đầu
Tai 1 ô nào đó nhập = tachduoi(B2) sẽ được phần sau

Public Function tachdau(cell As Range)
  Dim a, i, kq, tam
    a = Split(cell, ",")
      For i = 0 To UBound(a)
        tam = Left(a(i), InStrRev(a(i), " "))
          kq = kq & Trim(tam) & ChrW(10)
      Next
  tachdau = kq
End Function

Public Function tachduoi(cell As Range)
  Dim a, i, kq, tam
    a = Split(cell, ",")
      For i = 0 To UBound(a)
        tam = Right(a(i), Len(a(i)) - InStrRev(a(i), " "))
          kq = kq & Trim(tam) & ChrW(10)
      Next
  tachduoi = kq
End Function

 

[dmtcvn]

Tôi lấy bài từ "NHỜ TRỢ GIÚP" xong không tìm được bài để đăng (bài đã chuyển)
Tôi đưa một cách khác tách bằng công thức:

 

[hienasian]

Thật là "Núi Thái Sơn". Cảm ơn rất nhiều. Đáp án tuyệt vời!

 

[nmhung49]

Mình cũng góp vui bằng vbscript, hình như nó chưa tối ưu cho lắm mong a chị góp ý thêm

Sub Test()
Dim Tach, vbs As Object, kq(), item, i As Long
Set vbs = CreateObject("VBscript.regexp")
Tach = Split([B3].Value, ",")
ReDim kq(1 To UBound(Tach) + 1, 1 To 2)
For Each item In Tach
    With vbs
    '.Global = True
    .Pattern = "\d+g"
    If .Test(item) Then
        i = i + 1
        kq(i, 1) = Trim(.Replace(item, ""))
        kq(i, 2) = Trim(Replace(item, kq(i, 1), ""))
    End If
    End With
Next
Range("f2").Resize(i, 2).Value = kq
End Sub