Code xoá khoảng trắng trong excel (1 người xem)

[AnhThu-1976]

Em chào anh/chị!
Em nhờ anh chị hỗ trợ và giúp đỡ code xoá khoảng trắng thừa từ ô D8 đến ô D cuối cùng
Em xin cảm ơn nhiều

 

[bebo021999]

Xóa ô trắng? Ô đã trắng rồi thì xóa cũng vậy thôi, khác nhau thế nào?
Có phải bạn muốn xóa khoảng trắng sau chuỗi ký tự?

 

[AnhThu-1976]

Xóa ô trắng? Ô đã trắng rồi thì xóa cũng vậy thôi, khác nhau thế nào?
Có phải bạn muốn xóa khoảng trắng sau chuỗi ký tự?

Dạ không, xoá khoảng trắng thừa ở trước , giữa và sau chuỗi như file đính kèm

 

[cantl]

Sub TrimCaiTien()
Dim rng As Range
Dim cell As Range
Set rng = Application.InputBox("OK", , , , , , , 8)
For Each cell In rng
cell.Value = Application.Trim(cell.Value)
Next cell
End Sub

 

[AnhThu-1976]

Sub TrimCaiTien()
Dim rng As Range
Dim cell As Range
Set rng = Application.InputBox("OK", , , , , , , 8)
For Each cell In rng
cell.Value = Application.Trim(cell.Value)
Next cell
End Sub

Nhở bạn sửa giúp, không dùng Inputbox

 

[cantl]

Nhở bạn sửa giúp, không dùng Inputbox

Anh sửa
Application.InputBox("OK", , , , , , , 8)
thành
Range("d8:d10")
Là được.

 

[HeSanbi]

@AnhThu-1976

Có điều gì cần cân nhắc như:

1. Giữ định dạng font và màu chữ của ô.
2. Có thể Undo được. Nếu không Undo chắc là phải đóng Excel mở lại. Nếu bỏ khoảng trắng không đúng ý.
3. Loại bỏ được các khoảng trắng khác như khoảng trắng không ngắt, khoảng trắng không có chiều rộng, ...

 

[AnhThu-1976]

Đây là code đã chỉnh sửa theo hướng trên

Sub TrimCaiTien()
    Dim rng As Range
    Dim cell As Range
    Dim lr As Long
    lr = Sheets("MA").Range("C" & Rows.Count).End(xlUp).Row
    Set rng = Application.Sheets("MA").Range("C13:C" & lr)
    For Each cell In rng
        cell.Value = Application.Trim(cell.Value)
    Next cell
End Sub