Tách từng chữ trong một chuỗi nhiều trường hợp (1 người xem)

letienmai · 14/6/20

Kính gửi: anh/chị
- Em có một bài toán về tách từng chữ có ý nghĩa trong một chuối văn bản ra nằm từng cells nhưng nghĩ mãi không ra cách vì chuỗi cần tách có cả tiếng việt, tiếng hoa, tiếng anh và số.
- Anh/chị có thể sử dụng công thức hoặc Function sử dụng code nhưng chạy được trên Office 2010.
- Rất mong anh/ chị có kinh nghiệm xem giúp em. (Vui lòng xem file đính kèm để hiểu rõ hơn)
Xin được cám ơn và hậu tạ!

Hoàng Tuấn 868 · 14/6/20

letienmai đã viết:
Kính gửi: anh/chị
- Em có một bài toán về tách từng chữ có ý nghĩa trong một chuối văn bản ra nằm từng cells nhưng nghĩ mãi không ra cách vì chuỗi cần tách có cả tiếng việt, tiếng hoa, tiếng anh và số.
- Anh/chị có thể sử dụng công thức hoặc Function sử dụng code nhưng chạy được trên Office 2010.
- Rất mong anh/ chị có kinh nghiệm xem giúp em. (Vui lòng xem file đính kèm để hiểu rõ hơn)
Xin được cám ơn và hậu tạ!

Mình chỉ làm được với điều kiện có dấu cách giữa các từ tiếng Hoa, bạn tham khảo nhé.

letienmai · 14/6/20

Hoàng Tuấn 868 đã viết:
Mình chỉ làm được với điều kiện có dấu cách giữa các từ tiếng Hoa, bạn tham khảo nhé.

- Mình xin cám ơn bạn nhé.
- Tuy nhiên nếu giữa các chữ hoa có dấu cách thì mình đã làm được.
- Rất mong nhận thêm các trợ giúp từ các anh/chị.

Hoàng Tuấn 868 · 14/6/20

letienmai đã viết:
- Mình xin cám ơn bạn nhé.
- Sẽ tuyệt vời hơn nếu giữa các chữ hoa không có dấu cách, do kết cấu nghĩa của nó là không có khoảng cách.

Vì cấu trúc tiếng Hoa nhiều hay ít nét thì máy tính cũng chỉ đếm là 1 ký tự nên mình chưa nghĩ được cách để tách riêng trong một chuỗi bạn ạ.

CHAOQUAY · 14/6/20

letienmai đã viết:
Kính gửi: anh/chị
- Em có một bài toán về tách từng chữ có ý nghĩa trong một chuối văn bản ra nằm từng cells nhưng nghĩ mãi không ra cách vì chuỗi cần tách có cả tiếng việt, tiếng hoa, tiếng anh và số.
- Anh/chị có thể sử dụng công thức hoặc Function sử dụng code nhưng chạy được trên Office 2010.
- Rất mong anh/ chị có kinh nghiệm xem giúp em. (Vui lòng xem file đính kèm để hiểu rõ hơn)
Xin được cám ơn và hậu tạ!

Bạn thử code này cho file bài 1.
Tạm thời kết quả để theo hàng ngang, nếu chốt kết quả đúng thì sẽ quay thành hàng dọc

Mã:

Option Explicit

Sub Tach()
Dim nguon
Dim tam
Dim kq
Dim rws
Dim i, j, k, x, z, t
nguon = Sheet2.Range("C5:C18")
rws = UBound(nguon)
ReDim kq(1 To rws, 1 To 100)
For i = 1 To rws
    j = 0
    If nguon(i, 1) <> "" Then
        For Each tam In Split(nguon(i, 1))
            t = ""
            x = ""
            For k = 1 To Len(tam)
                x = Mid(tam, k, 1)
                If AscW(x) > 7929 Then
                    j = j + 1
                    kq(i, j) = x
                Else
                    t = t & x
                End If
            Next k
            If t <> "" Then
                j = j + 1
                kq(i, j) = t
            End If
        Next tam
    End If
    If z < j Then z = j
Next i
With Sheet2
    .Range("F5").Resize(rws, z) = kq
End With
End Sub

---
Có lẽ bạn gửi file có đầu vào nhiều dòng hơn 1 chút để test thì kết quả sẽ tốt hơn

letienmai · 14/6/20

CHAOQUAY đã viết:
Bạn thử code này cho file bài 1.
Tạm thời kết quả để theo hàng ngang, nếu chốt kết quả đúng thì sẽ quay thành hàng dọc

Mã:

Option Explicit Sub Tach() Dim nguon Dim tam Dim kq Dim rws Dim i, j, k, x, z, t nguon = Sheet2.Range("C5:C18") rws = UBound(nguon) ReDim kq(1 To rws, 1 To 100) For i = 1 To rws j = 0 If nguon(i, 1) <> "" Then For Each tam In Split(nguon(i, 1)) t = "" x = "" For k = 1 To Len(tam) x = Mid(tam, k, 1) If AscW(x) > 7929 Then j = j + 1 kq(i, j) = x Else t = t & x End If Next k If t <> "" Then j = j + 1 kq(i, j) = t End If Next tam End If If z < j Then z = j Next i With Sheet2 .Range("F5").Resize(rws, z) = kq End With End Sub

---
Có lẽ bạn gửi file có đầu vào nhiều dòng hơn 1 chút để test thì kết quả sẽ tốt hơn

Chào bạn
- Sub đã chạy đúng kết quả theo hàng ngang.
- Tuy nhiên mình mong muốn nó như một Function tham chiếu động tại vị trí ô và sheet bất kỳ, vì hiện tại nếu Run Sub thì nó cố định ô và sheet, cụ thể trong file là Sheet1.Range("F5")
- Bạn xem có thay đổi theo hướng trên mình trình bày đc không?

CHAOQUAY · 14/6/20

letienmai đã viết:
Chào bạn
- Sub đã chạy đúng kết quả theo hàng ngang.
- Tuy nhiên mình mong muốn nó như một Function tham chiếu động tại vị trí ô và sheet bất kỳ, vì hiện tại nếu Run Sub thì nó cố định ô và sheet, cụ thể trong file là Sheet1.Range("F5")
- Bạn xem có thay đổi theo hướng trên mình trình bày đc không?

Chuyển về hàm được thôi bạn, nhưng cần xác định trước là có thể file sẽ khá nặng đó nhé.

letienmai · 14/6/20

CHAOQUAY đã viết:
Chuyển về hàm được thôi bạn, nhưng cần xác định trước là có thể file sẽ khá nặng đó nhé.

File mình tính chất chỉ dưới 100 dòng thôi bạn nhé.
Nếu chuyển đc về công thức là tốt nhất.

CHAOQUAY · 14/6/20

letienmai đã viết:
File mình tính chất chỉ dưới 100 dòng thôi bạn nhé.
Nếu chuyển đc về công thức là tốt nhất.

Bạn test hàm dưới đây.
Cú pháp : Tach( Chuỗi đầu vào, vị trí chuỗi con cần lấy )

Mã:

Option Explicit

Public Function Tach(ByVal dauvao As String, ByVal vitri As Integer) As String
Dim tam As Variant
Dim chuoiR As String, chuoiG As String
Dim kq
Dim i, j, k
ReDim kq(1 To Len(dauvao))
For Each tam In Split(Application.Trim(dauvao))
    chuoiG = ""
    chuoiR = ""
    For i = 1 To Len(tam)
        chuoiR = Mid(tam, i, 1)
        If AscW(chuoiR) > 7929 Then
            j = j + 1
            If j = vitri Then
                Tach = chuoiR
                Exit Function
            End If
            kq(j) = chuoiR
        Else
            chuoiG = chuoiG & chuoiR
        End If
    Next i
    If chuoiG <> "" Then
        j = j + 1
        If j = vitri Then
            Tach = chuoiG
            Exit Function
        End If
        kq(j) = chuoiG
    End If
Next tam
If vitri > j Then Exit Function
Tach = kq(vitri)
End Function

---
code bài 5 và bài này chưa tính tới trường hợp nhóm ký tự dính liền có ký tự chữ tượng hình nằm phía cuối nhóm. Việc này có lẽ bạn chủ động kiểm tra, có gì tính tiếp sau nhé

letienmai · 14/6/20

CHAOQUAY đã viết:
Bạn test hàm dưới đây.
Cú pháp : Tach( Chuỗi đầu vào, vị trí chuỗi con cần lấy )

Mã:

Option Explicit Public Function Tach(ByVal dauvao As String, ByVal vitri As Integer) As String Dim tam As Variant Dim chuoiR As String, chuoiG As String Dim kq Dim i, j, k ReDim kq(1 To Len(dauvao)) For Each tam In Split(Application.Trim(dauvao)) chuoiG = "" chuoiR = "" For i = 1 To Len(tam) chuoiR = Mid(tam, i, 1) If AscW(chuoiR) > 7929 Then j = j + 1 If j = vitri Then Tach = chuoiR Exit Function End If kq(j) = chuoiR Else chuoiG = chuoiG & chuoiR End If Next i If chuoiG <> "" Then j = j + 1 If j = vitri Then Tach = chuoiG Exit Function End If kq(j) = chuoiG End If Next tam If vitri > j Then Exit Function Tach = kq(vitri) End Function

---
code bài 5 và bài này chưa tính tới trường hợp nhóm ký tự dính liền có ký tự chữ tượng hình nằm phía cuối nhóm. Việc này có lẽ bạn chủ động kiểm tra, có gì tính tiếp sau nhé

Chữ việt thì trả KQ đúng, chữ hoa vẫn bị đảo bạn nhé (Hình đính kèm)
Nhờ bạn xem lại giúp. Với lại bạn nhắn giùm mình stk mình gửi mời bạn cà phê thay lời cám ơn nhé.

CHAOQUAY · 15/6/20

letienmai đã viết:
Chữ việt thì trả KQ đúng, chữ hoa vẫn bị đảo bạn nhé (Hình đính kèm)
Nhờ bạn xem lại giúp. Với lại bạn nhắn giùm mình stk mình gửi mời bạn cà phê thay lời cám ơn nhé.

Tìm dòng lệnh trên, thay bằng dòng dưới.

Mã:

'If AscW(chuoiR) > 7929 Then
 If Abs(AscW(chuoiR)) > 7929 Then

---
Bài này làm chơi thôi bạn, không cần thiết cà phê cà pháo đâu bạn.

letienmai · 15/6/20

CHAOQUAY đã viết:
Tìm dòng lệnh trên, thay bằng dòng dưới.

Mã:

'If AscW(chuoiR) > 7929 Then If Abs(AscW(chuoiR)) > 7929 Then

---
Bài này làm chơi thôi bạn, không cần thiết cà phê cà pháo đâu bạn.

Vậy mình cám ơn bạn nhiều nhé, chúc bạn nhiều sức khỏe.

huuthang_bd · 15/6/20

Nếu dữ liệu không phải là 南定an giang mà là an giang南定 thì kết quả như thế nào?
Nếu dựa vào mã ký tự thì có thể không dùng vòng lặp cũng được.

letienmai · 17/6/20

CHAOQUAY đã viết:
Bạn test hàm dưới đây.
Cú pháp : Tach( Chuỗi đầu vào, vị trí chuỗi con cần lấy )

Mã:

Option Explicit Public Function Tach(ByVal dauvao As String, ByVal vitri As Integer) As String Dim tam As Variant Dim chuoiR As String, chuoiG As String Dim kq Dim i, j, k ReDim kq(1 To Len(dauvao)) For Each tam In Split(Application.Trim(dauvao)) chuoiG = "" chuoiR = "" For i = 1 To Len(tam) chuoiR = Mid(tam, i, 1) If AscW(chuoiR) > 7929 Then j = j + 1 If j = vitri Then Tach = chuoiR Exit Function End If kq(j) = chuoiR Else chuoiG = chuoiG & chuoiR End If Next i If chuoiG <> "" Then j = j + 1 If j = vitri Then Tach = chuoiG Exit Function End If kq(j) = chuoiG End If Next tam If vitri > j Then Exit Function Tach = kq(vitri) End Function

---
code bài 5 và bài này chưa tính tới trường hợp nhóm ký tự dính liền có ký tự chữ tượng hình nằm phía cuối nhóm. Việc này có lẽ bạn chủ động kiểm tra, có gì tính tiếp sau nhé

Bạn ơi cho mình hỏi thêm với là sao có trường hợp nó không hiển thị được chữ mà chỉ hiện ô vuông, cái đó là do mã AscW đúng không bạn?
Mình có đính kèm file trường hợp này. xin cám ơn.

befaint · 17/6/20

letienmai đã viết:
không hiển thị được chữ mà chỉ hiện ô vuông

Bởi ký tự đó có độ lớn len() = 2
Vụ này có nhiều rồi mà..

letienmai · 17/6/20

befaint đã viết:
Bởi ký tự đó có độ lớn len() = 2
Vụ này có nhiều rồi mà..

Em mới gặp lần đầu anh có thể hướng dẫn được không ạ? hoặc gợi ý cho em từ khóa tìm kiếm cũng được ạ.

CHAOQUAY · 17/6/20

letienmai đã viết:
Bạn ơi cho mình hỏi thêm với là sao có trường hợp nó không hiển thị được chữ mà chỉ hiện ô vuông, cái đó là do mã AscW đúng không bạn?
Mình có đính kèm file trường hợp này. xin cám ơn.

Có lẽ bạn gửi số lượng mẫu lớn hơn để test 1 lần cho xong.

letienmai · 18/6/20

CHAOQUAY đã viết:
Có lẽ bạn gửi số lượng mẫu lớn hơn để test 1 lần cho xong.

Dạ chỉ còn trường hợp này nữa là Ok rồi anh.
Cám ơn anh

HieuCD · 18/6/20

letienmai đã viết:
Kính gửi: anh/chị
- Em có một bài toán về tách từng chữ có ý nghĩa trong một chuối văn bản ra nằm từng cells nhưng nghĩ mãi không ra cách vì chuỗi cần tách có cả tiếng việt, tiếng hoa, tiếng anh và số.
- Anh/chị có thể sử dụng công thức hoặc Function sử dụng code nhưng chạy được trên Office 2010.
- Rất mong anh/ chị có kinh nghiệm xem giúp em. (Vui lòng xem file đính kèm để hiểu rõ hơn)
Xin được cám ơn và hậu tạ!

Thử Function

Mã:

Function XYZ(ByVal iText As String, ByVal iIndex As Integer) As String
  Dim S_tmp, tmp, S, Res, iChr$, i&, k&
 
  S_tmp = Split(Application.Trim(iText))
  For Each tmp In S_tmp
    For i = Len(tmp) To 2 Step -1
      If (Abs(AscW(Mid(tmp, i, 1))) > 7929) <> (Abs(AscW(Mid(tmp, i - 1, 1))) > 7929) Then
        tmp = Mid(tmp, 1, i - 1) & " " & Mid(tmp, i, Len(tmp))
      End If
    Next i
    S = Split(tmp)
    For Each Res In S
      If Abs(AscW(Mid(Res, 1, 1))) > 7929 Then
        For i = 1 To Len(Res)
          iChr = Mid(Res, i, 1)
          If AscW(iChr) < 0 Then
            If i < Len(Res) Then
              If AscW(Mid(Res, i + 1, 1)) < 0 Then
                iChr = Mid(Res, i, 2)
                i = i + 1
              End If
            End If
          End If
          k = k + 1
          If k >= iIndex Then XYZ = iChr: Exit Function
        Next i
      Else
        k = k + 1
        If k = iIndex Then XYZ = Res: Exit Function
      End If
    Next Res
  Next tmp
End Function

VetMini · 18/6/20

1 vấn đề; 18 lần trao đổi, trong đó có 4 lần code và 6 lần góp ý.
Trình độ diễn tả vấn đè của thớt đáng nể thật

letienmai · 18/6/20

VetMini đã viết:
1 vấn đề; 18 lần trao đổi, trong đó có 4 lần code và 6 lần góp ý.
Trình độ diễn tả vấn đè của thớt đáng nể thật

Cám ơn anh đã góp ý, tuy nhiên anh cũng góp phần thêm một lần trao đổi mà mình cho rằng nó vô nghĩa vì không mang tính xây dựng và đóng góp hơn là chỉ trích người khác.

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

HieuCD đã viết:

Thử Function

Mã:

Function XYZ(ByVal iText As String, ByVal iIndex As Integer) As String
  Dim S_tmp, tmp, S, Res, iChr$, i&, k&

  S_tmp = Split(Application.Trim(iText))
  For Each tmp In S_tmp
    For i = Len(tmp) To 2 Step -1
      If (Abs(AscW(Mid(tmp, i, 1))) > 7929) <> (Abs(AscW(Mid(tmp, i - 1, 1))) > 7929) Then
        tmp = Mid(tmp, 1, i - 1) & " " & Mid(tmp, i, Len(tmp))
      End If
    Next i
    S = Split(tmp)
    For Each Res In S
      If Abs(AscW(Mid(Res, 1, 1))) > 7929 Then
        For i = 1 To Len(Res)
          iChr = Mid(Res, i, 1)
          If AscW(iChr) < 0 Then
            If i < Len(Res) Then
              If AscW(Mid(Res, i + 1, 1)) < 0 Then
                iChr = Mid(Res, i, 2)
                i = i + 1
              End If
            End If
          End If
          k = k + 1
          If k >= iIndex Then XYZ = iChr: Exit Function
        Next i
      Else
        k = k + 1
        If k = iIndex Then XYZ = Res: Exit Function
      End If
    Next Res
  Next tmp
End Function

Code đã cho ra kết quả hết sức tuyệt vời.
Chân thành cám ơn anh và chúc anh thật nhiều sức khỏe nhé.

VetMini · 18/6/20

letienmai đã viết:
Cám ơn anh đã góp ý, tuy nhiên anh cũng góp phần thêm một lần trao đổi mà mình cho rằng nó vô nghĩa vì không mang tính xây dựng và đóng góp hơn là chỉ trích người khác.
...

Tôi biết ở đây nhiều người là dân da mặt mỏng. Chỉ muốn nhờ vả mà không muốn tiến bộ.
Tôi góp ý xây dựng cho người khác: nhìn kỹ lại vấn đề, tìm cách diễn giải nó rõ rệt và nghiêm chỉnh là đã tự mình giải quyết được gần hết.

Ở đây ai cũng biết tôi không bao giờ khuyến khích kiểu giải thích vấn đề một cách nhỏ giọt.

Tách từng chữ trong một chuỗi nhiều trường hợp (1 người xem)

Người dùng đang xem chủ đề này

Thành viên hoạt động

File đính kèm

Đăng ký hôm qua

File đính kèm

Thành viên hoạt động

Đăng ký hôm qua

Thành viên gắn bó

Thành viên hoạt động

Thành viên gắn bó

Thành viên hoạt động

Thành viên gắn bó

Thành viên hoạt động

File đính kèm

Thành viên gắn bó

Thành viên hoạt động

Chuyên gia GPE

Thành viên hoạt động

File đính kèm

|||||||||||||

Thành viên hoạt động

Thành viên gắn bó

Thành viên hoạt động

Chuyên gia GPE

Đang đi tìm hòn đá

Thành viên hoạt động

Đang đi tìm hòn đá

Thời gian đếm ngược.