Code để bỏ ký tự " ;" cuối chuỗi trong ô của excel

[quanglenb]

Xin chào các Thầy cô, anh chị trên GPE.
Em xin được các anh chị giúp em đoạn code để có thể bỏ ký tự " ;" cuối chuỗi kể từ ô G2 trong cột G.
Khi chạy code các ký tự " ;" cuối chuỗi ký tự trong ô được loại bỏ.
hình 1 (dữ liệu ban đầu)
Hình 2 (kết quả khi chạy code)
Em xin cảm ơn!



uả)

 

[befaint]

=TRIM( SUBSTITUTE( G2,";","",LEN( G2)-LEN( SUBSTITUTE(G2,";",""))))

 

[quanglenb]

=TRIM( SUBSTITUTE( G2,";","",LEN( G2)-LEN( SUBSTITUTE(G2,";",""))))

Dạ em cảm ơn thầy, Nếu có thời gian xin được nhờ thầy có thể giúp em bằng code với ạ?

 

[befaint]

Sub t
const sColRef = "G"
const iRowMin = 2
const sDelim = ";"
Dim ws as worksheet, data as variant, lastRow as long, i as long, strText as string

set ws = activesheet
lastRow = ws.range(sColRef, ws.rows.count).end(xlup).row
if lastRow < iRowMin then
msgbox "Khong co du lieu!"
Exit sub
End if
data = ws.range(sColRef & iRowMin).resize(lastRow - iRowMin +1 +1).value2
lastRow = ubound(data,1) -1
for i = 1 to lastRow
strText = vba.trim$(data(i,1))
if vba.right$(strText,1) = sDelim then
mid(strText, len(strText),1) = ""
data(i,1) =vba.trim$( strText)
end if
next i
ws.range(sColRef & iRowMin).resize(lastRow).value = data
End sub

 

[VetMini]

=TRIM( SUBSTITUTE( G2,";","",LEN( G2)-LEN( SUBSTITUTE(G2,";",""))))

Code thì chỉ "bấm một phát"
Hàm thì phải gõ hàm, fill down, copy/paste values, rồi xóa.
Nhiều hơn những 4 động tác. Tội gì phải tốn công trong khi có thể nhờ được?

Chú thích về hàm: nếu tôi giải bài bài này thì tôi cộng một ký tự | vào cuối chuỗi rồi substittute.
=Substitute(Substitute(chuỗi&"|", ";|", ""), "|", "")
Lần subs thứ nhì là đề phòng trường hợp chuỗi không kết bằng ";"
(chưa trim)

 

[ptm0412]

Nếu tôi giải bài này thì
=trim(LEFT(G4,LEN(G4)-2))
Nếu dự phòng cuối chuỗi không phải ";" thì
=IF(TRIM(RIGHT(G4,2))=";",TRIM(LEFT(G4,LEN(G4)-2)),G4)
Vậy cho đơn giản

 

[quanglenb]

Sub t
const sColRef = "G"
const iRowMin = 2
const sDelim = ";"
Dim ws as worksheet, data as variant, lastRow as long, i as long, strText as string

set ws = activesheet
lastRow = ws.range(sColRef, ws.rows.count).end(xlup).row
if lastRow < iRowMin then
msgbox "Khong co du lieu!"
Exit sub
End if
data = ws.range(sColRef & iRowMin).resize(lastRow - iRowMin +1 +1).value2
lastRow = ubound(data,1) -1
for i = 1 to lastRow
strText = vba.trim$(data(i,1))
if vba.right$(strText,1) = sDelim then
mid(strText, len(strText),1) = ""
data(i,1) =vba.trim$( strText)
end if
next i
ws.range(sColRef & iRowMin).resize(lastRow).value = data
End sub

Em cảm ơn thầy ạ!

 

[bebo021999]

Nếu dưới vài ngàn dòng thì dùng cách này:

Sub delete()
Dim cell As Range
For Each cell In Range("G4:G" & Cells(Rows.Count, "G").End(xlUp).Row)
    cell.Value = Split(cell.Value & "$?#", ";$?#")(0)
Next
End Sub

Nhiều hơn thì ghi vào mảng rồi dán xuống sheet nhé.

 

[quanglenb]

Sub t
const sColRef = "G"
const iRowMin = 2
const sDelim = ";"
Dim ws as worksheet, data as variant, lastRow as long, i as long, strText as string

set ws = activesheet
lastRow = ws.range(sColRef, ws.rows.count).end(xlup).row
if lastRow < iRowMin then
msgbox "Khong co du lieu!"
Exit sub
End if
data = ws.range(sColRef & iRowMin).resize(lastRow - iRowMin +1 +1).value2
lastRow = ubound(data,1) -1
for i = 1 to lastRow
strText = vba.trim$(data(i,1))
if vba.right$(strText,1) = sDelim then
mid(strText, len(strText),1) = ""
data(i,1) =vba.trim$( strText)
end if
next i
ws.range(sColRef & iRowMin).resize(lastRow).value = data
End sub

Em chạy code thấy báo lỗi ạ!
xin được thầy xem giúp!

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

Nếu dưới vài ngàn dòng thì dùng cách này:

Sub delete()
Dim cell As Range
For Each cell In Range("G4:G" & Cells(Rows.Count, "G").End(xlUp).Row)
    cell.Value = Split(cell.Value & "$?#", ";$?#")(0)
Next
End Sub

Nhiều hơn thì ghi vào mảng rồi dán xuống sheet nhé.

em cảm ơn thầy, với những ô mà không có ký tự cần xóa ở cuối dòng thì lại tự thêm ký tự như hình khi chạy code, thầy xem giúp em ạ

 

[befaint]

Em chạy code thấy báo lỗi ạ!

Mình viết sai. Bạn chỉnh lại thế này nhé.

lastRow = ws.range(sColRef & ws.rows.count).end(xlup).row

 

[quanglenb]

Mình viết sai. Bạn chỉnh lại thế này nhé.

lastRow = ws.range(sColRef & ws.rows.count).end(xlup).row

Em có sửa lại và chạy code nhưng không có tác dụng ạ!
Xin được thầy xem giúp!

 

[befaint]

Em có sửa lại và chạy code nhưng không có tác dụng ạ!
Xin được thầy xem giúp!

.

Đây bạn nhé .

 

[bebo021999]

Thử lại:

Sub delete()
Dim cell As Range
For Each cell In Range("G4:G" & Cells(Rows.Count, "G").End(xlUp).Row)
    If Right(cell, 1) Like ";" Then cell.Value = Split(cell.Value & "$?#", ";$?#")(0)
Next
End Sub

 

[quanglenb]

Thử lại:

Sub delete()
Dim cell As Range
For Each cell In Range("G4:G" & Cells(Rows.Count, "G").End(xlUp).Row)
    If Right(cell, 1) Like ";" Then cell.Value = Split(cell.Value & "$?#", ";$?#")(0)
Next
End Sub

Vâng, em cảm ơn thầy

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

.

Đây bạn nhé .

Dạ được rồi ạ! em xin cảm ơn!