Giúp giùm macro xóa hàng trong cell (1 người xem)

[Hưng Bắp]

Chào mọi người,
Tôi có vài file excel trong đó có nhiều cell chứa 2 hàng (Alt-enter xuống hàng trong cell).
Nhờ mọi người cho xin code để xóa hàng dưới trong tất cả các cell được chọn cùng một lúc.
Rất cám ơn.

 

[vu_tuan_manh_linh]

Code thế này thôi:

Sub XoaEnter()
Dim Ws As Worksheet
Dim Rg As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each Ws In ActiveWorkbook.Worksheets
    If Ws.Visible = xlSheetVisible Then
        Ws.Activate
    Else
        Ws.Visible = xlSheetVisible
        Ws.Activate
    End If
    For Each Rg In ActiveSheet.UsedRange
        If InStr(1, Rg.Value, Chr(10)) > 0 Then
            Rg.Value = Left(Rg.Value, InStr(1, Rg.Value, Chr(10)) - 1)
        End If
    Next
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[Hưng Bắp]

Code thế này thôi:

Sub XoaEnter()

Dim Ws As Worksheet

Dim Rg As Range

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

For Each Ws In ActiveWorkbook.Worksheets

    If Ws.Visible = xlSheetVisible Then

        Ws.Activate

    Else

        Ws.Visible = xlSheetVisible

        Ws.Activate

    End If

    For Each Rg In ActiveSheet.UsedRange

        If InStr(1, Rg.Value, Chr(10)) > 0 Then

            Rg.Value = Replace(Rg.Value, Chr(10), Chr(32))

        End If

    Next

Next

Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic

End Sub

Mình sẽ thử ngay.
Cám ơn bạn Mạnh Linh nhiều.

 

[Hưng Bắp]

Code thế này thôi:

Sub XoaEnter()
Dim Ws As Worksheet
Dim Rg As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each Ws In ActiveWorkbook.Worksheets
    If Ws.Visible = xlSheetVisible Then
        Ws.Activate
    Else
        Ws.Visible = xlSheetVisible
        Ws.Activate
    End If
    For Each Rg In ActiveSheet.UsedRange
        If InStr(1, Rg.Value, Chr(10)) > 0 Then
            Rg.Value = Left(Rg.Value, InStr(1, Rg.Value, Chr(10)) - 1)
        End If
    Next
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Bạn Mạnh Linh ơi,
Ý mình cần xóa toàn bộ những hàng dưới trong cell chứ không chỉ xóa enter (gộp hàng dưới lên hàng trên).
Và chỉ thực thi trên các cell được chọn.
Bạn chịu khó sửa giúp mình với.
Cám ơn bạn.

 

[ndu96081631]

Code thế này thôi:

Sub XoaEnter()
Dim Ws As Worksheet
Dim Rg As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each Ws In ActiveWorkbook.Worksheets
    If Ws.Visible = xlSheetVisible Then
        Ws.Activate
    Else
        Ws.Visible = xlSheetVisible
        Ws.Activate
    End If
    For Each Rg In ActiveSheet.UsedRange
        If InStr(1, Rg.Value, Chr(10)) > 0 Then
            Rg.Value = Left(Rg.Value, InStr(1, Rg.Value, Chr(10)) - 1)
        End If
    Next
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Tôi tưởng chỉ thế này thôi chứ

Sub Test()
  Dim wks As Worksheet
  For Each wks In ThisWorkbook.Worksheets
    wks.UsedRange.Replace vbLf & "*", vbNullString, xlPart
  Next
End Sub

 

[befaint]

nhiều cell chứa 2 hàng (Alt-enter xuống hàng trong cell).
Nhờ mọi người cho xin code để xóa hàng dưới trong tất cả các cell cùng một lúc.

Sub Ctrl_H()
    Cells.Replace What:=Chr(10) & "*", Replacement:=""
End Sub

 

[vu_tuan_manh_linh]

Bạn Mạnh Linh ơi,
Ý mình cần xóa toàn bộ những hàng dưới trong cell chứ không chỉ xóa enter (gộp hàng dưới lên hàng trên).
Và chỉ thực thi trên các cell được chọn.
Bạn chịu khó sửa giúp mình với.
Cám ơn bạn.

Code đã sửa lại rồi bạn nhé!

 

[vu_tuan_manh_linh]

Tôi tưởng chỉ thế này thôi chứ

Sub Test()
  Dim wks As Worksheet
  For Each wks In ThisWorkbook.Worksheets
    wks.UsedRange.Replace vbLf & "*", vbNullString, xlPart
  Next
End Sub

Oh! Lại thêm một lần mở mang tầm mắt! Thanks bác NDU! Code đầu em bị sai ý tưởng, em đã sửa lại! Bác có giải pháp nào tốt hơn việc duyệt từng cell không ạ! Nếu dữ liệu không có formula mà chỉ value đơn thuần, bác giúp em cái code dùng scripting gì gì đó được không ạ! Em ngó cái vụ này mãi mà đọc mãi chưa hiểu!

 

[Hưng Bắp]

Tôi tưởng chỉ thế này thôi chứ

Sub Test()
  Dim wks As Worksheet
  For Each wks In ThisWorkbook.Worksheets
    wks.UsedRange.Replace vbLf & "*", vbNullString, xlPart
  Next
End Sub

Cám ơn bạn nđu6081631.
Mình đã thử và hiệu quả.
Tuy nhiên mình chỉ muốn xóa trong các cell được chọn chứ không xóa cả sheet.
Bạn có thể sửa code giúp mình không?
Thanks.

 

[vu_tuan_manh_linh]

Bạn Mạnh Linh ơi,
Ý mình cần xóa toàn bộ những hàng dưới trong cell chứ không chỉ xóa enter (gộp hàng dưới lên hàng trên).
Và chỉ thực thi trên các cell được chọn.
Bạn chịu khó sửa giúp mình với.
Cám ơn bạn.

Bạn muốn xóa cùng lúc trên tất cả các sheet, lại muốn xóa trong vùng được chọn thì nghe ra khó, nếu không có file xem vùng cần xóa của bạn có dấu hiệu nhận diện gì không thì chịu cứng cái vụ "tất cả các sheet cùng lúc" luôn, mà phải chơi bán tự động!

 

[Hưng Bắp]

Code đã sửa lại rồi bạn nhé!

Cám ơn bạn Mạnh Linh.

 

[Hưng Bắp]

Sub Ctrl_H()
    Cells.Replace What:=Chr(10) & "*", Replacement:=""
End Sub

Cám ơn bạn befaint.
Mọi người rất nhiệt tình, cám ơn tất cả mọi người!

 

[ndu96081631]

Cám ơn bạn nđu6081631.
Mình đã thử và hiệu quả.
Tuy nhiên mình chỉ muốn xóa trong các cell được chọn chứ không xóa cả sheet.
Bạn có thể sửa code giúp mình không?
Cảm ơn.

Vậy càng dễ

Sub Test()
  If TypeName(Selection) = "Range" Then Selection.Replace vbLf & "*", vbNullString, xlPart
End Sub

 

[vu_tuan_manh_linh]

Vậy càng dễ

Sub Test()
  If TypeName(Selection) = "Range" Then Selection.Replace vbLf & "*", vbNullString, xlPart
End Sub

Tuyệt vời!! Thú thật với bác NDU là cái tư duy duyệt cell nó ngấm vào đầu em mất rồi!!

 

[Hưng Bắp]

Bạn muốn xóa cùng lúc trên tất cả các sheet, lại muốn xóa trong vùng được chọn thì nghe ra khó, nếu không có file xem vùng cần xóa của bạn có dấu hiệu nhận diện gì không thì chịu cứng cái vụ "tất cả các sheet cùng lúc" luôn, mà phải chơi bán tự động!

Xin lỗi vì mình diễn giải không rõ.
Mình muốn xóa một range cụ thể trong 1 sheet cụ thể.
Lần đầu tham gia diễn đàn, mãi bây giờ mới đọc thấy câu hỏi của Linh, thông cảm nhé
Bạn sửa code giúp mình được không?
Thanks bạn nhiều.

 

[vu_tuan_manh_linh]

Xin lỗi vì mình diễn giải không rõ.
Mình muốn xóa một range cụ thể trong 1 sheet cụ thể.
Lần đầu tham gia diễn đàn, mãi bây giờ mới đọc thấy câu hỏi của Linh, thông cảm nhé
Bạn sửa code giúp mình được không?
Cảm ơn bạn nhiều.

Range cụ thể là cụ thể thế nào bạn? Địa chỉ như thế nào?

 

[Hưng Bắp]

Code của bác NDU hiệu quả và đúng với nhu cầu của mình.
Cám ơn Mạnh Linh, NDU và befaint.
P/s: vừa thử code vừa đọc diễn đàn nên mãi bây giờ mới thấy hết các trả lời, xin lỗi.
Bạn Mạnh Linh không phải sửa nữa, cám ơn bạn và tất cả mọi người.

 

[Hưng Bắp]

Cám ơn

 

[ndu96081631]

Anh có thể thêm giúp mình code để xóa hàng trên không? (2 macro riêng biệt)
Cảm ơn.

Sửa vblf & "*" thành "*" & vbLf
Tức:

Sub Test2()
  If TypeName(Selection) = "Range" Then Selection.Replace "*" & vbLf, vbNullString, xlPart
End Sub

 

[Hưng Bắp]

Sửa vblf & "*" thành "*" & vbLf
Tức:

Sub Test2()
  If TypeName(Selection) = "Range" Then Selection.Replace "*" & vbLf, vbNullString, xlPart
End Sub

Cám ơn admin NDU nhiều.