Xin hỏi về code xóa cột có điều kiện

[tam8678]

Rất mong các anh, em trên GPE xem và hướng dẫn giúp cách xóa cột theo điều kiện: không có dữ liệu trong cột, cụ thể trong file đính kèm. Cám ơn

 

[nghiaphuc]

Rất mong các anh, em trên GPE xem và hướng dẫn giúp cách xóa cột theo điều kiện: không có dữ liệu trong cột, cụ thể trong file đính kèm. Cám ơn

Bạn xem file đính kèm nhé. Mình chọn vùng chứa dữ liệu để kiểm tra là các cột I:S. Nếu dữ liệu thực sự của bạn có nhiều cột hơn thì sửa vùng này lại cho phù hợp.

 

[tam8678]

Bạn xem file đính kèm nhé. Mình chọn vùng chứa dữ liệu để kiểm tra là các cột I:S. Nếu dữ liệu thực sự của bạn có nhiều cột hơn thì sửa vùng này lại cho phù hợp.

---
Trong trường hợp các cột P, Q, R, S không có dữ liệu thì Run code không xóa 1 lần được bạn ơi. Bạn kiểm tra và xem giúp dùm nhé. Cám ơn

 

[nghiaphuc]

---
Trong trường hợp các cột P, Q, R, S không có dữ liệu thì Run code không xóa 1 lần được bạn ơi. Bạn kiểm tra và xem giúp dùm nhé. Cám ơn

Bạn thử thay bằng Sub này xem sao:

Sub Xoa_cot()
    Dim Cot As Integer
    Cot = 9
    Do While Cells(4, Cot) <> ""
        If Cells(65536, Cot).End(xlUp).Row = 4 Then
            Cells(4, Cot).EntireColumn.Delete
        Else
            Cot = Cot + 1
        End If
    Loop
End Sub

 

[tam8678]

Bạn thử thay bằng Sub này xem sao:

Sub Xoa_cot()
    Dim Cot As Integer
    Cot = 9
    Do While Cells(4, Cot) <> ""
        If Cells(65536, Cot).End(xlUp).Row = 4 Then
            Cells(4, Cot).EntireColumn.Delete
        Else
            Cot = Cot + 1
        End If
    Loop
End Sub

---
Cám ơn bạn, code tiện ích lắm, bạn vui lòng hướng dẫn đọan code nhé.
---
Nhờ các bạn xem, giúp phần code vừa xóa dòng và xóa cột (cụ thể trong file đính kèm)
Cám ơn

 

[ptlong04x1]

Rất mong các anh, em trên GPE xem và hướng dẫn giúp cách xóa cột theo điều kiện: không có dữ liệu trong cột, cụ thể trong file đính kèm. Cám ơn

Thêm đoạn code để anh tham khảo :

Sub test()
    Dim i As Long
    With ActiveSheet.UsedRange
        For i = .Columns.Count To 1 Step -1
            If WorksheetFunction.CountA(.Cells(1, i).EntireColumn) = 1 Then _
                .Cells(1, i).EntireColumn.Delete
        Next i
    End With
End Sub

 

[ptlong04x1]

Bạn thử thay bằng Sub này xem sao:

Sub Xoa_cot()
    Dim Cot As Integer
    Cot = 9
    Do While Cells(4, Cot) <> ""
        If Cells(65536, Cot).End(xlUp).Row = 4 Then
            Cells(4, Cot).EntireColumn.Delete
        Else
            Cot = Cot + 1
        End If
    Loop
End Sub

Code của bạn có nhược điểm thế này, nó vẫn phải phụ thuộc vào chỉ số của cột đầu tiên có chứa dữ liệu, ở đây là cột 9 :

Cot =9

Vì vậy, nếu như ta xoá đi các cột phía trước cột TĐ, lúc này cột 9 không còn là cột đầu tiên có chứa dữ liệu nữa thì code sẽ chạy sai.

 

[ndu96081631]

---
Cám ơn bạn, code tiện ích lắm, bạn vui lòng hướng dẫn đọan code nhé.
---
Nhờ các bạn xem, giúp phần code vừa xóa dòng và xóa cột (cụ thể trong file đính kèm)
Cám ơn

Em làm như sau:
- Việc xóa dòng có số thiếu <=0 ta chuyển giao cho AutoFilter làm
- Xóa cột trong em dùng SpecialCell
Code tuy dài như em nghĩ thuật toán này cho tốc độ cực nhanh đây, vì khi xóa cột, vòng lập chỉ duyệt qua các cell rổng đầu tiên thôi

Sub XoaDongCot()
  Dim Rng As Range, FilterRng As Range, Temp As Range
  Dim Sothieu As Range, Clls As Range, BlkRng As Range
  On Error GoTo Thoat
  Set Rng = Application.InputBox("Chon vung du lieu" & vbLf & _
                                 "Luu ý: khong chon tieu de cot", Type:=8)
  Set FilterRng = Range(Rng, Rng.Offset(-1))
  Set Sothieu = Application.InputBox("Chon 1 cell trong cot SO THIEU", Type:=8)
  With FilterRng
    .AutoFilter Sothieu.Column - Rng.Column + 1, "<=0"
    Rng.SpecialCells(12).EntireRow.Delete
    .AutoFilter
  End With
  Set BlkRng = Rng.Resize(1).SpecialCells(4)
  If Not BlkRng Is Nothing Then
    Set Temp = BlkRng(1, 1)
    For Each Clls In BlkRng
      If Clls.End(xlDown).Row > Rng.Row + Rng.Rows.Count - 1 Then
        Set Temp = Union(Temp, Clls)
      End If
    Next Clls
    Temp.EntireColumn.Delete
  End If
Thoat:
  ActiveSheet.AutoFilterMode = False
End Sub

 

[tam8678]

Em làm như sau:
- Việc xóa dòng có số thiếu <=0 ta chuyển giao cho AutoFilter làm
- Xóa cột trong em dùng SpecialCell
Code tuy dài như em nghĩ thuật toán này cho tốc độ cực nhanh đây, vì khi xóa cột, vòng lập chỉ duyệt qua các cell rổng đầu tiên thôi
...

Rất cám ơn chú, nhưng ý anh là code này (Ví dụ: Sub Xoa) nằm trong 1 sub khác (ví dụ Sub A), khi Run sub A thì sẽ Run Xoa nên không chọn vùng = tay được. Chú hiểu ý anh chứ. Đương nhiên là trước khi xóa số liệu sẽ được lưu qua sh Data (số kế hoạch đã hoàn thành)

 

[tam8678]

Thêm đoạn code để anh tham khảo :

Sub test()
    Dim i As Long
    With ActiveSheet.UsedRange
        For i = .Columns.Count To 1 Step -1
            If WorksheetFunction.CountA(.Cells(1, i).EntireColumn) = 1 Then _
                .Cells(1, i).EntireColumn.Delete
        Next i
    End With
End Sub

---
Long à, ý nghĩa của code này là thế nào? Hướng dẫn giúp anh nhé

 

[ptlong04x1]

---
Long à, ý nghĩa của code này là thế nào? Hướng dẫn giúp anh nhé

Sub test()
    Dim i As Long
    With ActiveSheet.UsedRange
        For i = .Columns.Count To 1 Step -1
            If WorksheetFunction.CountA(.Cells(1, i).EntireColumn) = 1 Then _
                .Cells(1, i).EntireColumn.Delete
        Next i
    End With
End Sub

UsedRange tạm gọi là Vùng sử dụng (VSD) : đại khái nó là 1 Range hình chữ nhật nhỏ nhất bao quanh các Cell có dữ liệu.

- Cho i chạy từ tổng số cột của VSD về 1 (Step -1 : chạy lùi, vd : 10 --> 9 --> 8 --> ... --> 1).

- Nếu cột (EntireColumn) chứa Cell(hàng 1, cột i) của VSD chỉ có 1 ô có dữ liệu (chỉ có ngày 04/01, mà không có dữ liệu) --> Xoá cột.

PS : À, mà có lẽ anh nên sửa code lại là :

If WorksheetFunction.CountA(.Cells(1, i).EntireColumn) <= 1 Then ...

Sẽ tiện hơn vì nếu cột nào trống rỗng thì cũng xoá luôn.

 

[ndu96081631]

Rất cám ơn chú, nhưng ý anh là code này (Ví dụ: Sub Xoa) nằm trong 1 sub khác (ví dụ Sub A), khi Run sub A thì sẽ Run Xoa nên không chọn vùng = tay được. Chú hiểu ý anh chứ. Đương nhiên là trước khi xóa số liệu sẽ được lưu qua sh Data (số kế hoạch đã hoàn thành)

Nếu không dùng tay để chọn thì anh phải xác định chính xác vùng dử liệu anh cần xóa là từ đâu đến đâu! Ít nhất là bắt đầu từ dòng nào, cột nào?
Có giống y chang như file anh giả lập không?

 

[tam8678]

Nếu không dùng tay để chọn thì anh phải xác định chính xác vùng dử liệu anh cần xóa là từ đâu đến đâu! Ít nhất là bắt đầu từ dòng nào, cột nào?
Có giống y chang như file anh giả lập không?

---
Cám ơn chú đã quan tâm, anh gởi file gốc chú xem. Rất mong sự góp ý
(Nếu không rõ thì thông báo nhé)

 

[sealand]

Rất cám ơn chú, nhưng ý anh là code này (Ví dụ: Sub Xoa) nằm trong 1 sub khác (ví dụ Sub A), khi Run sub A thì sẽ Run Xoa nên không chọn vùng = tay được. Chú hiểu ý anh chứ. Đương nhiên là trước khi xóa số liệu sẽ được lưu qua sh Data (số kế hoạch đã hoàn thành)

Tại sao lại không nhỉ? Anh Tam8678 tham khảo xem sao?

Sub Ktra()
kt = MsgBox("Co dong y tim xoa DL khong?", vbOKCancel, "XOA DL")
If kt = 1 Then xoa
End Sub
'-----------------------------------------------------------------
Sub xoa()
Dim Rg As Range
On Error GoTo Thoat
Set Rg = Application.InputBox("Go vao hay dung chuot chon vung can xoa", "XOA DL", , , , , , 8)
Rg.ClearContents
Exit Sub
Thoat:
End Sub

 

[quick87]

Mong các thầy và các anh chị hướng dẫn với trường hợp của em:

Dữ liệu của em có nhiều cột, em muốn dữ lại 1 cột theo điều kiện, các cột khác sẽ xóa hết như hình đính kèm:



Em gửi file đính kèm, mong các Thầy và các anh chị giúp đỡ ạ.
Em xin cảm ơn !

 

[Ba Tê]

Mong các thầy và các anh chị hướng dẫn với trường hợp của em:

Dữ liệu của em có nhiều cột, em muốn dữ lại 1 cột theo điều kiện, các cột khác sẽ xóa hết như hình đính kèm:



Em gửi file đính kèm, mong các Thầy và các anh chị giúp đỡ ạ.
Em xin cảm ơn !

Sub này chỉ dành cho file của bạn thôi nhé, Nhập Chon DV vào InPutBox - OK.
Sẽ chừa lại các cột có tiêu đề là Chon DV, Nhập "tầm bậy" nó xóa sạch vì không có thằng nào đúng điều kiện chừa lại.

Public Sub GPE()
Application.ScreenUpdating = False
Dim Rng As Range, DK As String, I As Long, Cot As Long
    Cot = [IV12].End(xlToLeft).Column
    Set Rng = Range([E12], Cells(12, Cot))
    DK = UCase(InputBox("Nhap tieu de Cot KHONG XOA: ", "GPE"))
        For I = Cot To 5 Step -1
        If UCase(Cells(12, I)) <> DK Then Cells(12, I).EntireColumn.Delete
        Next I
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

 

[quick87]

Trường hợp của em đã được giải quyết, Code chạy rất tốt !
Em cảm ơn Thầy thật nhiều ạ.