Copy, bỏ merge, xoá hoàn toàn cột/hàng không có dữ liệu (1 người xem)

[dangmaunhan]

Gửi các Thầy, anh/chị,
Em có sheet 1 là dữ liệu gốc (file dữ liệu rất nặng và có nhiều thông tin "bí mật") em không thể đưa lên đầy đủ được (file rất nặng (khoảng 10mb), em cắt bớt dữ liệu để có thể upload thành công). Nhưng em có mô phỏng lại file dữ liệu của em ở sheet 1 sao cho phản ảnh được yêu cầu vấn đề.

Vấn đề của em là muốn copy file gốc ở sheet 1 (đang merge) sang sheet 2. Sau đó tiến hành bỏ merge đi, lúc này sẽ xuất hiện nhiều cột trống (hoàn toàn không có dữ liệu). Cuối cùng là xoá hoàn toàn những cột trống này để được kết quả giống như ở sheet 3 (bước 3).

Kính mong các thầy, anh/chị viết code VBA để giải quyết giúp em vấn đề này ạ. Code có thể sử dụng tổng quát cho tất cả các file với các thao tác ở trên (copy, bỏ merge, xoá hoàn toàn cột/hàng trống) không chỉ riêng file này
Em cảm ơn các thầy, anh/chị nhiều nhiều. hjhj

 

[Let'GâuGâu]

Gửi các Thầy, anh/chị,
Em có sheet 1 là dữ liệu gốc (file dữ liệu rất nặng và có nhiều thông tin "bí mật") em không thể đưa lên đầy đủ được (file rất nặng (khoảng 10mb), em cắt bớt dữ liệu để có thể upload thành công). Nhưng em có mô phỏng lại file dữ liệu của em ở sheet 1 sao cho phản ảnh được yêu cầu vấn đề.

Vấn đề của em là muốn copy file gốc ở sheet 1 (đang merge) sang sheet 2. Sau đó tiến hành bỏ merge đi, lúc này sẽ xuất hiện nhiều cột trống (hoàn toàn không có dữ liệu). Cuối cùng là xoá hoàn toàn những cột trống này để được kết quả giống như ở sheet 3 (bước 3).

Kính mong các thầy, anh/chị viết code VBA để giải quyết giúp em vấn đề này ạ. Code có thể sử dụng tổng quát cho tất cả các file với các thao tác ở trên (copy, bỏ merge, xoá hoàn toàn cột/hàng trống) không chỉ riêng file này
Em cảm ơn các thầy, anh/chị nhiều nhiều. hjhj

thử đoạn code ghi lại bằng record macro này xem

Sub Macro2()
    
    On Error Resume Next
    Application.ScreenUpdating = False
    Sheets("buoc 1").Copy After:=Sheets(Sheets.Count)
        With [a11].Resize([A1000].End(3).Row, [iv11].End(xlToLeft).Column).SpecialCells(xlCellTypeBlanks)
                .UnMerge
                .SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
        End With
    
    Application.ScreenUpdating = True
    On Error GoTo 0
    
End Sub

 

[dangmaunhan]

thử đoạn code ghi lại bằng record macro này xem

Sub Macro2()
    
    On Error Resume Next
    Application.ScreenUpdating = False
    Sheets("buoc 1").Copy After:=Sheets(Sheets.Count)
        With [a11].Resize([A1000].End(3).Row, [iv11].End(xlToLeft).Column).SpecialCells(xlCellTypeBlanks)
                .UnMerge
                .SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
        End With
    
    Application.ScreenUpdating = True
    On Error GoTo 0
    
End Sub

Vẫn chưa được anh ơi, run macro thì chỉ thấy thao tác copy được thực hiện thôi? Anh xem lại code giúp e nữa nha.

 

[ptm0412]

Gởi Dang mau Nhan,
Unmerge là 1 method của Range
Xóa cột tương tự như xóa dòng

Nhân xem lại mấy cái này đã học trong lớp rồi.

 

[Let'GâuGâu]

Vẫn chưa được anh ơi, run macro thì chỉ thấy thao tác copy được thực hiện thôi? Anh xem lại code giúp e nữa nha.

sorry bạn,sau khi dọn dẹp lại record macro, test ko kỹ
tôi viết thì chỉ ở trình độ record macro thui....kàkà.......

Sub Macro2()
    
    On Error Resume Next
    Application.ScreenUpdating = False
    Sheets("buoc 1").Copy After:=Sheets(Sheets.Count)
    Cells.UnMerge
    With [a11].Resize([A1000].End(3).Row - 10, [iv11].End(xlToLeft).Column)
        .SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
        .EntireColumn.AutoFit
    End With

    Application.ScreenUpdating = True
    On Error GoTo 0
    
End Sub

 

[ptm0412]

sorry bạn,sau khi dọn dẹp lại record macro, test ko kỹ
tôi viết thì chỉ ở trình độ record macro thui....kàkà.......

    With [a11].Resize([A1000].End(3).Row - 10, [iv11].End(xlToLeft).Column)
        .SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
        .EntireColumn.AutoFit
    End With

Chạy code này chắc xóa tùm lum cột. Xóa cả cột trống lẫn cột chứa không đủ dữ liệu trong cột, thí dụ cột d, e, f, x, u (chữ trên tiêu đề cột dòng 11)

 

[dangmaunhan]

Gởi Dang mau Nhan,
Unmerge là 1 method của Range
Xóa cột tương tự như xóa dòng

Nhân xem lại mấy cái này đã học trong lớp rồi.

Chào thầy ạ,
Thao tác copy và bỏ merge thì em làm ok,
Còn xoá cột trắng thì chưa ok cho lắm,
Em dùng vòng lặp For để xoá, nhưng vẫn chưa xoá được, nó nhảy lung tung lắm ạ.

 

[ptm0412]

Chào thầy ạ,
Thao tác copy và bỏ merge thì em làm ok,
Còn xoá cột trắng thì chưa ok cho lắm,
Em dùng vòng lặp For để xoá, nhưng vẫn chưa xoá được, nó nhảy lung tung lắm ạ.

Xóa dòng hay xóa cột phải for từ lớn xuống nhỏ, step -1, nhớ không?

Và điều kiện xóa chỉ là dòng cần xét, ở đây là dòng tiêu đề, tức là dòng 11

If Cells(11, i) = "" Then ...

Còn nếu như điều kiện nguyên cột trống mới xóa (lỡ có cột nào có dữ liệu mà không có tiêu đề), thì dùng điều kiện Application.CountA(cột i) = 0

 

[Let'GâuGâu]

Chạy code này chắc xóa tùm lum cột. Xóa cả cột trống lẫn cột chứa không đủ dữ liệu trong cột, thí dụ cột d, e, f, x, u (chữ trên tiêu đề cột dòng 11)

không xóa thầy ạh, nếu thầy có thời gian rảnh, thầy cho code chạy thử
tiêu đề các cột:a,b,d,e,f,h còn nguyên. sai chổ nào thầy chỉ dạy thêm
cám ơn thầy

 

[ptm0412]

không xóa thầy ạh, nếu thầy có thời gian rảnh, thầy cho code chạy thử
tiêu đề các cột:a,b,d,e,f,h còn nguyên. sai chổ nào thầy chỉ dạy thêm
cám ơn thầy

Về ý nghĩa câu lệnh mà nói thì xóa tùm lum, thực tế may là các ô ở các cột có tiêu đề có chứa dữ liệu (chuỗi rỗng) chứ không phải là blank đúng nghĩa. Nếu blank đúng nghĩa tức là các ô chưa hề đụng đến, thì xóa nhiều lắm. Bạn thử tô xóa các ô trống đó rồi chạy lại code sẽ thấy.

Ngoài ra, nếu chắc chắn rằng cột không có tiêu đề là cột cần xóa, thì chỉ cần resize(1, số cột) chứ không cần resize(số dòng, số cột).

Còn nếu không chắc chắn (không có tiêu đề mà có dữ liệu), thì phải kiểm tra tất cả ô trong cột đó rỗng mới được xóa.

 

[dangmaunhan]

Xóa dòng hay xóa cột phải for từ lớn xuống nhỏ, step -1, nhớ không?

Và điều kiện xóa chỉ là dòng cần xét, ở đây là dòng tiêu đề, tức là dòng 11

If Cells(11, i) = "" Then ...

Còn nếu như điều kiện nguyên cột trống mới xóa (lỡ có cột nào có dữ liệu mà không có tiêu đề), thì dùng điều kiện Application.CountA(cột i) = 0

Em có đoạn code như dưới đây. Em muốn xác định cột cuối, và dòng đầu tiên có dữ liệu để chạy vba tổng quát cho các file. Nhưng em thấy code lấy dòng đầu tiên chưa đúng lắm, test code thì không đạt yêu cầu. Mong thầy hướng dẫn thêm giúp em ạ.
Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+Shift+C
'
Sheets(1).Copy After:=Sheets(1)
Cells.Select
Selection.UnMerge
Dim FirstRow As Integer
Dim LastCol As Integer
LastCol = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
FirstRow = ActiveSheet.UsedRange.Row
For i = LastCol To 1 Step -1
If Cells(FirstRow, i) = "" Then
Columns(i).EntireColumn.Delete
End If
Next i
End Sub

 

[ptm0412]

Em có đoạn code như dưới đây. Em muốn xác định cột cuối, và dòng đầu tiên có dữ liệu để chạy vba tổng quát cho các file. Nhưng em thấy code lấy dòng đầu tiên chưa đúng lắm, test code thì không đạt yêu cầu. Mong thầy hướng dẫn thêm giúp em ạ.

Dùng LastCol như thế này là sai:

LastCol = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRang e.Columns.Count).Column

ActiveSheet.UsedRange.Columns.Count (thiếu .Count) cho biết số cột (đếm được) của vùng dữ liệu đã dùng
ActiveSheet.UsedRange.Columns.Count là 1 sự lặp lại không cần thiết và sai cú pháp, chắc sẽ báo lỗi
Column là property của 1 range, cho biết số thứ tự cột đầu tiên của range. Range("A1").Column = 1 và Range ("A1:A10").Column và Range("A1:X10").Column cũng bằng 1.

Nói về phương pháp tổng quát thì khó, vì nhiều lý do:

1. Dữ liệu bắt đầu từ dòng bất kỳ
2. Do dòng tiêu đề (bắt đầu dữ liệu) là dòng bất kỳ, nên UsedRange không phải bắt đầu từ dòng đó, mà bắt đầu từ dòng 1. Ngoài ra nếu đã từng làm nháp trên các cột bên phải dữ liệu và/ hoặc đã định dạng, thì dù sau đó đã xóa đi, Used Range cũng bao trùm các cột nháp đó. Thử bằng câu lệnh ActiveSheet.UsedRange.Select.
3. Dùng CurrentRegion nghe có vẻ hợp lý hơn, nhưng với điều kiện:
- Dữ liệu cột 1 và dòng 1 (của dữ liệu) liên tục
- 4 bên trái phải trên dưới của dữ liệu có ít nhất 1 dòng trống hoặc cột trống.



Phương pháp giải quyết đơn giản: Dùng 1 Inputbox type = 8 để người dùng chọn ô bất kỳ, hoặc cả dòng của dòng đầu tiên chứa tiêu đề.

Thí dụ như sau:

Dim TitleRng As Range, TitleRow As Long, LastCol As Long
Set TitleRng = InputBox("Title Rows to be run?", "Delete Column", , , , , , 8)
TitleRow = TitleRng.Row
LastCol = ActiveSheet.Cells(TitleRow, 200).End(xlToLeft).Column

'UnMege tại đây, tránh việc UnMerge tác động đến cả sheet có thể gây chậm chạp'
ActiveSheet.Cells(TitleRow,1).Resize([LastCol,1).UnMerge

For i = LastCol to 1 Step -1
...

Hoặc sau khi xác định LastCol, dùng như Let's Go:

With ActiveSheet.Cells(TitleRow,1).Resize([LastCol,1)
        .UnMerge
        .SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
        .EntireColumn.AutoFit
    End With

 

[dangmaunhan]

Dùng LastCol như thế này là sai:

LastCol = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRang e.Columns.Count).Column

ActiveSheet.UsedRange.Columns.Count (thiếu .Count) cho biết số cột (đếm được) của vùng dữ liệu đã dùng
ActiveSheet.UsedRange.Columns.Count là 1 sự lặp lại không cần thiết và sai cú pháp, chắc sẽ báo lỗi
Column là property của 1 range, cho biết số thứ tự cột đầu tiên của range. Range("A1").Column = 1 và Range ("A1:A10").Column và Range("A1:X10").Column cũng bằng 1.

Nói về phương pháp tổng quát thì khó, vì nhiều lý do:

1. Dữ liệu bắt đầu từ dòng bất kỳ
2. Do dòng tiêu đề (bắt đầu dữ liệu) là dòng bất kỳ, nên UsedRange không phải bắt đầu từ dòng đó, mà bắt đầu từ dòng 1. Ngoài ra nếu đã từng làm nháp trên các cột bên phải dữ liệu và/ hoặc đã định dạng, thì dù sau đó đã xóa đi, Used Range cũng bao trùm các cột nháp đó. Thử bằng câu lệnh ActiveSheet.UsedRange.Select.
3. Dùng CurrentRegion nghe có vẻ hợp lý hơn, nhưng với điều kiện:
- Dữ liệu cột 1 và dòng 1 (của dữ liệu) liên tục
- 4 bên trái phải trên dưới của dữ liệu có ít nhất 1 dòng trống hoặc cột trống.



Phương pháp giải quyết đơn giản: Dùng 1 Inputbox type = 8 để người dùng chọn ô bất kỳ, hoặc cả dòng của dòng đầu tiên chứa tiêu đề.

Thí dụ như sau:

Dim TitleRng As Range, TitleRow As Long, LastCol As Long
Set TitleRng = InputBox("Title Rows to be run?", "Delete Column", , , , , , 8)
TitleRow = TitleRng.Row
LastCol = ActiveSheet.Cells(TitleRow, 200).End(xlToLeft).Column

'UnMege tại đây, tránh việc UnMerge tác động đến cả sheet có thể gây chậm chạp'
ActiveSheet.Cells(TitleRow,1).Resize([LastCol,1).UnMerge

For i = LastCol to 1 Step -1
...

Hoặc sau khi xác định LastCol, dùng như Let's Go:

With ActiveSheet.Cells(TitleRow,1).Resize([LastCol,1)
        .UnMerge
        .SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
        .EntireColumn.AutoFit
    End With

Em vẫn chưa hiểu được ý nghĩa của 2 đoạn code này, mong thầy gợi ý thêm giúp e ạ. Cảm ơn Thầy nhiều.
Set TitleRng = InputBox("Title Rows to be run?", "Delete Column", , , , , , 8)
ActiveSheet.Cells(TitleRow,1).Resize([LastCol,1).UnMerge

 

[ptm0412]

Em vẫn chưa hiểu được ý nghĩa của 2 đoạn code này, mong thầy gợi ý thêm giúp e ạ. Cảm ơn Thầy nhiều.
Set TitleRng = InputBox("Title Rows to be run?", "Delete Column", , , , , , 8)
TitleRow = TitleRng.Row
LastCol = ActiveSheet.Cells(TitleRow, 200).End(xlToLeft).Column
ActiveSheet.Cells(TitleRow,1).Resize([LastCol,1).UnMerge

Sorry, dòng xác định LastCol phải ở trên.
Resize đúng ra là Resize(1, LastCol)

1. InputtBox thì đã học rồi mà? Type = 8 tức là hỏi và người dùng chọn 1 Range. Và vì Range là 1 object nên phải dùng Set để gán giá trị chứ không gán thông thường như biến kiểu khác.

2. Khi người dùng đã chọn 1 ô, hoặc 1 dòng, hoặc 1 ô bị merge, ta cần xác định dòng đó là dòng bao nhiêu (câu lệnh 2), thí dụ được 10

3. Xác định cột cuối (câu này thì OK chứ?), thí dụ được 20

4. Câu Resize cũng dễ mà? Cells(10, 1).Resize(1, 20) sẽ được 1 Range 1 dòng 20 cột. Range này bị uýnh bởi method UnMerge