Tách các chuỗi nhỏ trước và sau các kí tự đặc biệt từ chuỗi lớn

[hadoan-pap]

Em chào mọi người!

Em có file dữ lieu như đính kèm ạ.

Em muốn tách các chuỗi con trước và sau các kí tự, dấu như (, ; - ; _ ; .) ạ.

Em Xin cảm ơn!

 

[Hoàng Tuấn 868]

Em chào mọi người!
Em có file dữ lieu như đính kèm ạ.
Em muốn tách các chuỗi con trước và sau các kí tự, dấu như (, ; - ; _ ; .) ạ.
Em Xin cảm ơn!

Cần gì đến lập trình bạn nhỉ.

 

[Nhattanktnn]

Em chào mọi người!

Em có file dữ lieu như đính kèm ạ.

Em muốn tách các chuỗi con trước và sau các kí tự, dấu như (, ; - ; _ ; .) ạ.

Em Xin cảm ơn!

Theo như bài thì hình như bạn không tách dấu chấm .
Thử code cho vui:

Sub Button1_Click()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, X As Long
Dim Tmp As Variant, Txt As String, iChr As String
Const sText As String = "(,-;_)"
With Sheets("Input")
    sArr = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Value
    ReDim dArr(1 To UBound(sArr), 1 To 20)
    For I = 1 To UBound(sArr)
        Txt = sArr(I, 1): X = 0
        For J = 1 To Len(sText)
            iChr = Mid(sText, J, 1)
            Txt = Replace(Txt, iChr, Chr(1))
        Next
        Tmp = Split(Txt, Chr(1))
        If UBound(Tmp) + 1 > UBound(dArr, 2) Then
            ReDim Preserve dArr(1 To UBound(sArr), 1 To UBound(Tmp) + 21)
        End If
        For K = 0 To UBound(Tmp)
            If Tmp(K) <> "" Then
                X = X + 1
                dArr(I, X) = Tmp(K)
            End If
        Next
    Next
    .Range("B2").Resize(10000, 10000).ClearContents
    .Range("B2").Resize(UBound(dArr, 1), UBound(dArr, 2)) = dArr
End With
End Sub

 

[HieuCD]

Em chào mọi người!

Em có file dữ lieu như đính kèm ạ.

Em muốn tách các chuỗi con trước và sau các kí tự, dấu như (, ; - ; _ ; .) ạ.

Em Xin cảm ơn!

Thêm code khác tí xíu

Sub Button1_Click()
  Dim sArr(), S, Res(), tmp$, sRow&, i&, j&, k&

  With Sheets("Input")
    sArr = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Value
    sRow = UBound(sArr)
    ReDim Res(1 To sRow, 1 To 10)
    For i = 1 To sRow
      tmp = Application.Trim(sArr(i, 1)): k = 0
      For j = 1 To 3
        tmp = Replace(tmp, Mid(";_-", j, 1), ",")
      Next
      If InStr(1, ".,", Right(tmp, 1)) > 0 Then tmp = Mid(tmp, 1, Len(tmp) - 1)
      S = Split(tmp, ",")
      If UBound(S) + 1 > UBound(Res, 2) Then
        ReDim Preserve Res(1 To sRow, 1 To UBound(Res, 2) + 10)
      End If
      For j = 0 To UBound(S)
        If S(j) <> Empty And S(j) <> " " Then
          k = k + 1
          Res(i, k) = Trim(S(j))
        End If
      Next
    Next
    .Range("B2").CurrentRegion.Offset(1, 1).ClearContents
    .Range("B2").Resize(sRow, UBound(Res, 2)) = Res
  End With
End Sub

 

[Nhattanktnn]

Thêm code khác tí xíu

Sub Button1_Click()
  Dim sArr(), S, Res(), tmp$, sRow&, i&, j&, k&

  With Sheets("Input")
    sArr = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Value
    sRow = UBound(sArr)
    ReDim Res(1 To sRow, 1 To 10)
    For i = 1 To sRow
      tmp = Application.Trim(sArr(i, 1)): k = 0
      For j = 1 To 3
        tmp = Replace(tmp, Mid(";_-", j, 1), ",")
      Next
      If InStr(1, ".,", Right(tmp, 1)) > 0 Then tmp = Mid(tmp, 1, Len(tmp) - 1)
      S = Split(tmp, ",")
      If UBound(S) + 1 > UBound(Res, 2) Then
        ReDim Preserve Res(1 To sRow, 1 To UBound(Res, 2) + 10)
      End If
      For j = 0 To UBound(S)
        If S(j) <> Empty And S(j) <> " " Then
          k = k + 1
          Res(i, k) = Trim(S(j))
        End If
      Next
    Next
    .Range("B2").CurrentRegion.Offset(1, 1).ClearContents
    .Range("B2").Resize(sRow, UBound(Res, 2)) = Res
  End With
End Sub

Đoạn bôi đậm chưa đúng rồi bác hiếu ơi..
Em không biết bôi đậm trong code thế nào mà nó không được, đoạn này nè bác:
If UBound(S) + 1 > UBound(Res, 2) Then
ReDim Preserve Res(1 To sRow, 1 To UBound(Res, 2) + 10)
End If

 

[Hai Lúa Miền Tây]

Đoạn bôi đậm chưa đúng rồi bác hiếu ơi..
Em không biết bôi đậm trong code thế nào mà nó không được, đoạn này nè bác:
If UBound(S) + 1 > UBound(Res, 2) Then
ReDim Preserve Res(1 To sRow, 1 To UBound(Res, 2) + 10)
End If

Dùng thẻ Rich (BB code) theo ví dụ như sau:

If UBound(S) + 1 > UBound(Res, 2) Then
        ReDim Preserve Res(1 To sRow, 1 To UBound(Res, 2) + 10)
End If

 

[Nhattanktnn]

Dùng thẻ Rich (BB code) theo ví dụ như sau:

If UBound(S) + 1 > UBound(Res, 2) Then
        ReDim Preserve Res(1 To sRow, 1 To UBound(Res, 2) + 10)
End If

cảm ơn anh ;p

 

[Hai Lúa Miền Tây]

Sao em thấy nó vẫn vậy anh, lúc gửi đi có in đậm nữa đâu (ủa được rồi nè, cảm ơn anh)

Bạn phải chắc chắn chọn đúng thẻ nhé:


Kết quả:

 

[Nhattanktnn]

Bạn phải chắc chắn chọn đúng thẻ nhé:

View attachment 259926
Kết quả:

View attachment 259927

Tại lúc nãy em thấy anh gửi cho em cũng không in đậm hay màu gì cả, mà giờ lại có rồi. Không biết anh có sửa gì không. Nhưng vậy là em hiểu rồi đó, sáng sớm phiền anh rồi

 

[HieuCD]

Đoạn bôi đậm chưa đúng rồi bác hiếu ơi..
Em không biết bôi đậm trong code thế nào mà nó không được, đoạn này nè bác:
If UBound(S) + 1 > UBound(Res, 2) Then
ReDim Preserve Res(1 To sRow, 1 To UBound(Res, 2) + 10)
End If

Mình dự đoán ubound(s) không biến động nhiều, cẩn thận hơn nên dùng theo cách của bạn

If UBound(S) + 1 > UBound(Res, 2) Then
        ReDim Preserve Res(1 To sRow, 1 To UBound(S) + 11)
End If

 

[hadoan-pap]

Em Xin cảm ơn tất cả mọi người ạ ^^ !