Nhờ giúp đỡ code tách dữ liệu và bỏ ký tự cuối

[Eric.Shen]

Chào các bác,
Em đang có một bài toán là cần tách chuỗi ký tự được ngăn cách nhau bởi dấu "/" và bỏ đi số cuối trong chuỗi ký tự
Em dùng text to column thì có thể tách ra được nhưng lại không bỏ được 1 ký tự cuối được
Các bác giúp em với nhé
Em cảm ơn ạ!

 

[soros20102020]

đoạn code cho bạn:
Sub TachChuoi()
Dim rng As Range
Dim cell As Range
Dim chuoi As String
Dim arrChuoi() As String
Dim i As Integer


Set rng = Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)

For Each cell In rng
chuoi = cell.Value


arrChuoi = Split(chuoi, "/")


For i = LBound(arrChuoi) To UBound(arrChuoi)

Cells(cell.Row, "B").Offset(0, i).Value = arrChuoi(i)
Next i
Next cell

End Sub

 

[Eric.Shen]

đoạn code cho bạn:
Sub TachChuoi()
Dim rng As Range
Dim cell As Range
Dim chuoi As String
Dim arrChuoi() As String
Dim i As Integer


Set rng = Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)

For Each cell In rng
chuoi = cell.Value


arrChuoi = Split(chuoi, "/")


For i = LBound(arrChuoi) To UBound(arrChuoi)

Cells(cell.Row, "B").Offset(0, i).Value = arrChuoi(i)
Next i
Next cell

End Sub

Bác ơi,
Code tách ra được rồi ạ, nhưng nó chưa giúp em bỏ ký tự cuối của mỗi chuỗi ạ, bác thêm giúp em tính năng đó với nhé

 

[Nhattanktnn]

đoạn code cho bạn:
Sub TachChuoi()
Dim rng As Range
Dim cell As Range
Dim chuoi As String
Dim arrChuoi() As String
Dim i As Integer


Set rng = Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)

For Each cell In rng
chuoi = cell.Value


arrChuoi = Split(chuoi, "/")


For i = LBound(arrChuoi) To UBound(arrChuoi)

Cells(cell.Row, "B").Offset(0, i).Value = arrChuoi(i)
Next i
Next cell

End Sub

Bạn đọc chưa kỹ câu hỏi của người ta rồi

 

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

Chào các bác,
Em đang có một bài toán là cần tách chuỗi ký tự được ngăn cách nhau bởi dấu "/" và bỏ đi số cuối trong chuỗi ký tự
Em dùng text to column thì có thể tách ra được nhưng lại không bỏ được 1 ký tự cuối được
Các bác giúp em với nhé
Em cảm ơn ạ!

Nếu dùng office 365 thì bạn thử hàm sau:

=LEFT(TEXTSPLIT(A2,"/"),LEN(TEXTSPLIT(A2,"/"))-1) => Kéo xuống

 

[soros20102020]

Sub TachChuoi()
Dim lastRow As Long
Dim i As Long
Dim chuoi As String
Dim arrChuoi() As String

' Xác định dòng cuối cùng trong cột A
lastRow = Cells(Rows.Count, "A").End(xlUp).Row

' Lặp qua từng dòng trong cột A
For i = 1 To lastRow
chuoi = Cells(i, "A").Value

' Tách chuỗi thành mảng các phần tử
arrChuoi = Split(chuoi, "/")

' Gán giá trị vào các cột tương ứng
For j = 1 To UBound(arrChuoi) + 1
' Kiểm tra độ dài chuỗi và bỏ đi kí tự cuối cùng
If Len(arrChuoi(j - 1)) > 0 Then
Cells(i, j + 1).Value = Left(arrChuoi(j - 1), Len(arrChuoi(j - 1)) - 1)
End If
Next j
Next i
End Sub

 

[Hoàng Tuấn 868]

Bạn đọc chưa kỹ câu hỏi của người ta rồi

Tốc độ rải code thế này (1 tiếng làm 4 bài) thì làm sao đủ thời gian để đọc kỹ.

 

[Nhattanktnn]

Tốc độ rải code thế này (1 tiếng làm 4 bài) thì làm sao đủ thời gian để đọc kỹ.

Có giúp là tốt rồi anh, sai mong muốn từ từ sửa được
À nhưng mà em nói thêm, code đó chắc do GPT viết

 

[Hoàng Tuấn 868]

Có giúp là tốt rồi anh, sai mong muốn từ từ sửa được

Chuẩn luôn, cũng mong duy trì và phát triển hơn nữa thì càng tốt.

 

[Eric.Shen]

Nếu dùng office 365 thì bạn thử hàm sau:

=LEFT(TEXTSPLIT(A2,"/"),LEN(TEXTSPLIT(A2,"/"))-1) => Kéo xuống

Vâng, em cảm ơn bác ạ
Em đang dùng bản 2016 nên chưa thử được ạ

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

Sub TachChuoi()
Dim lastRow As Long
Dim i As Long
Dim chuoi As String
Dim arrChuoi() As String

' Xác định dòng cuối cùng trong cột A
lastRow = Cells(Rows.Count, "A").End(xlUp).Row

' Lặp qua từng dòng trong cột A
For i = 1 To lastRow
chuoi = Cells(i, "A").Value

' Tách chuỗi thành mảng các phần tử
arrChuoi = Split(chuoi, "/")

' Gán giá trị vào các cột tương ứng
For j = 1 To UBound(arrChuoi) + 1
' Kiểm tra độ dài chuỗi và bỏ đi kí tự cuối cùng
If Len(arrChuoi(j - 1)) > 0 Then
Cells(i, j + 1).Value = Left(arrChuoi(j - 1), Len(arrChuoi(j - 1)) - 1)
End If
Next j
Next i
End Sub

đúng rồi bác ạ
Em cảm ơn bác nhiều ạ

 

[Hoàng Tuấn 868]

À nhưng mà em nói thêm, code đó chắc do GPT viết

Mình cũng đoán vậy vì phần chú thích đều tăm tắp, trên diễn đàn thì hiếm có ai làm vậy.

 

[bebo021999]

Mình cũng đoán vậy vì phần chú thích đều tăm tắp, trên diễn đàn thì hiếm có ai làm vậy.

Mình không nghĩ vậy vì 2 lý do:
1) code dùng biến Chuoi và arrChuoi: chuoi là từ "chuỗi" trong tiếng Việt.
2) code GPT thường hay có phần xác định sheet mà nó đang làm việc.
Ví dụ:
Sheets("Sheet1").Activate

 

[Thóc Sama]

Code tự viết cũng được, ai đó viết cũng được, gpt viết cũng được....
Nhưng mà để ngoài thẻ code thì không được.
Nhìn nhức mắt thấy mẹ.

 

[bebo021999]

đúng rồi bác ạ
Em cảm ơn bác nhiều ạ

Nếu data của bạn có vài ngàn dòng trở lên, thì phương án loop qua từng ô trên bảng tính là không ổn, sẽ làm treo máy
Bạn nên dùng array, tính toán trên đó, sau đó copy trở lại sheet thì giúp tốc độ nhanh hơn và mượt mà hơn:

Option Explicit
Sub tachchuoi()
Dim lr&, i&, j&, st, rng, res(1 To 10000, 1 To 100)
lr = Cells(Rows.Count, "A").End(xlUp).Row
rng = Range("A2:A" & lr).Value ' luu gia tri cua vung vao array
For i = 1 To UBound(rng)
    st = Split(rng(i, 1), "/") ' tach chuoi ra dua theo dau "/"
    Select Case UBound(st)
        Case 0 ' neu chi co 1 so
            res(i, 1) = Left(st(0), Len(st(0)) - 1)
        Case Else ' neu tu 2 so tro len
            For j = 0 To UBound(st)
                res(i, j + 1) = Left(st(j), Len(st(j)) - 1)
            Next
    End Select
Next
Range("B2").Resize(UBound(rng), 100).Value = res
End Sub

 

[Eric.Shen]

Nếu data của bạn có vài ngàn dòng trở lên, thì phương án loop qua từng ô trên bảng tính là không ổn, sẽ làm treo máy
Bạn nên dùng array, tính toán trên đó, sau đó copy trở lại sheet thì giúp tốc độ nhanh hơn và mượt mà hơn:

Option Explicit
Sub tachchuoi()
Dim lr&, i&, j&, st, rng, res(1 To 10000, 1 To 100)
lr = Cells(Rows.Count, "A").End(xlUp).Row
rng = Range("A2:A" & lr).Value ' luu gia tri cua vung vao array
For i = 1 To UBound(rng)
    st = Split(rng(i, 1), "/") ' tach chuoi ra dua theo dau "/"
    Select Case UBound(st)
        Case 0 ' neu chi co 1 so
            res(i, 1) = Left(st(0), Len(st(0)) - 1)
        Case Else ' neu tu 2 so tro len
            For j = 0 To UBound(st)
                res(i, j + 1) = Left(st(j), Len(st(j)) - 1)
            Next
    End Select
Next
Range("B2").Resize(UBound(rng), 100).Value = res
End Sub

Vâng ạ,
Em cảm ơn bác đã cải tiến và giúp đỡ em ạ
Code này chạy rất mượn với dữ liệu lớn ạ

 

[VetMini]

Code tự viết cũng được, ai đó viết cũng được, gpt viết cũng được....
Nhưng mà để ngoài thẻ code thì không được.
Nhìn nhức mắt thấy mẹ.

Ngược lại, tôi nhìn code không trong thẻ chả sao. Chỉ loại code không có chú thích mới mệt.
Code để trong thẻ PHP cũng có lúc khó đọc, màu đỏ tùm lum hết.
(PHP coi dấu ; là ký tự chấm dứt câu lệnh, VBA coi xuống hàng là hết một câu lệnh - trừ phi có ký tự nối hàng)

 

[ptm0412]

Code để trong thẻ PHP cũng có lúc khó đọc, màu đỏ tùm lum hết.

Đỏ tùm lum tại không biết cách thôi. Cũng là code bé bo, người có tầm cỡ làm sẽ thấy khác:

Option Explicit
Sub tachchuoi()
Dim lr&, i&, j&, st, rng, res(1 To 10000, 1 To 100)
lr = Cells(Rows.Count, "A").End(xlUp).Row
rng = Range("A2:A" & lr).Value '' luu gia tri cua vung vao array
For i = 1 To UBound(rng)
    st = Split(rng(i, 1), "/") '' tach chuoi ra dua theo dau "/"
    Select Case UBound(st)
        Case 0 '' neu chi co 1 so
            res(i, 1) = Left(st(0), Len(st(0)) - 1)
        Case Else '' neu tu 2 so tro len
            For j = 0 To UBound(st)
                res(i, j + 1) = Left(st(j), Len(st(j)) - 1)
            Next
    End Select
Next
Range("B2").Resize(UBound(rng), 100).Value = res
End Sub

 

[VetMini]

Đỏ tùm lum tại không biết cách thôi. Cũng là code bé bo, người có tầm cỡ làm sẽ thấy khác:
...

Chả thấy khác mấy. Thay vì đỏ tùm lum, bi giờ còn mấy màu khác nữa.
Điển hình: tại sao For có màu tím mà Next thì màu đen? tại sao hằng số và hàm thì cùng màu (xanh)?

Lưu ý: code trên không cấn lệnh Select. Phần Case 0 chả thấy chỗ nào mà không gồm vào Case Else được!

 

[Maika8008]

Tôi thấy dùng thẻ Rich (BB code) là ổn nhất, khỏi màu mè rối mắt.