Xoá cột theo kí hiệu

[sep_hatxel]

Mình có một vấn đề rất mong GPE giúp đỡ bằng macro:
-Ở 1 sheet dữ liệu: Dòng 3 là kí hiệu của các cột, các kí hiệu này là bất kì.
- Vấn đề cần giải quyết: xoá cột theo kí hiệu
Ví dụ: mình cần xoá cột có kí hiệu 5, y, 4 thì chỉ việc nhập các kí hiệu của cột cần xoá là 5, y, 4 và thực hiện lệnh xoá cột, tất cả các cột có kí hiệu ở dòng 3 là 5, y, 4 sẽ bị xoá đi và các cột còn lại tự động dồn lại theo thứ tự.
* Rất mong GPE giúp đỡ và xin trân trọng cảm ơn!

 

[Hai Lúa Miền Tây]

Mình có một vấn đề rất mong GPE giúp đỡ bằng macro:
-Ở 1 sheet dữ liệu: Dòng 3 là kí hiệu của các cột, các kí hiệu này là bất kì.
- Vấn đề cần giải quyết: xoá cột theo kí hiệu
Ví dụ: mình cần xoá cột có kí hiệu 5, y, 4 thì chỉ việc nhập các kí hiệu của cột cần xoá là 5, y, 4 và thực hiện lệnh xoá cột, tất cả các cột có kí hiệu ở dòng 3 là 5, y, 4 sẽ bị xoá đi và các cột còn lại tự động dồn lại theo thứ tự.
* Rất mong GPE giúp đỡ và xin trân trọng cảm ơn!

Ví dụ A1 là chuổi cần nhập làm điều kiện, code sẽ như sau:

Sub test()
Dim arr As Variant, i As Integer, c As Integer, cll As Range
arr = Split([a1], ",")
Set cll = Range("B3:AW3")
For i = LBound(arr) To UBound(arr)
    For c = cll.Columns.Count To 1 Step -1
        If Cells(3, c) Like arr(i) Then Cells(3, c).EntireColumn.Delete
    Next
Next
Erase arr

End Sub

 

[sep_hatxel]

Ví dụ A1 là chuổi cần nhập làm điều kiện, code sẽ như sau:

Sub test()
Dim arr As Variant, i As Integer, c As Integer, cll As Range
arr = Split([a1], ",")
Set cll = Range("B3:AW3")
For i = LBound(arr) To UBound(arr)
    For c = cll.Columns.Count To 1 Step -1
        If Cells(3, c) Like arr(i) Then Cells(3, c).EntireColumn.Delete
    Next
Next
Erase arr

End Sub

Vâng! Xin cảm ơn thầy rất nhiều! Cảm ơn GPE! Rất tuyệt thầy ạ!

 

[sep_hatxel]

Mình có thêm một vấn đề gần giống như trên mong GPE và thầy Hai Lúa Miền Tây xem giúp:
-Ở 1 sheet dữ liệu: Dòng 3 là kí hiệu của các cột, các kí hiệu này là bất kì.
- Vấn đề cần giải quyết: coppy cột theo kí hiệu
Ví dụ: mình cần coppy cột có kí hiệu 5, y, 4 thì chỉ việc nhập các kí hiệu của cột cần coppy là 5, y, 4 và thực hiện lệnh coppy cột, tất cả các cột có kí hiệu ở dòng 3 là 5, y, 4 sẽ được coppy và past sang sheet2 và các cột được coppy dồn lại lần lượt theo thứ tự.
* Rất mong GPE giúp đỡ và xin trân trọng cảm ơn! (Vẫn sử dụng file dữ liệu ở bài #1)

 

[Hai Lúa Miền Tây]

Mình có thêm một vấn đề gần giống như trên mong GPE và thầy Hai Lúa Miền Tây xem giúp:
-Ở 1 sheet dữ liệu: Dòng 3 là kí hiệu của các cột, các kí hiệu này là bất kì.
- Vấn đề cần giải quyết: coppy cột theo kí hiệu
Ví dụ: mình cần coppy cột có kí hiệu 5, y, 4 thì chỉ việc nhập các kí hiệu của cột cần coppy là 5, y, 4 và thực hiện lệnh coppy cột, tất cả các cột có kí hiệu ở dòng 3 là 5, y, 4 sẽ được coppy và past sang sheet2 và các cột được coppy dồn lại lần lượt theo thứ tự.
* Rất mong GPE giúp đỡ và xin trân trọng cảm ơn! (Vẫn sử dụng file dữ liệu ở bài #1)

Bạn dùng code sau nhé:

Sub test1()
Dim Arr As Variant, i As Integer, c As Integer, cll As Range
With Sheet2
    Sheet1.Range("A1:AW4000").Copy .[a1]
    Set cll = .Range("B3:AX3")
    Arr = Split(.[a1], ",")
    For i = LBound(Arr) To UBound(Arr)
        For c = cll.Columns.Count To 2 Step -1
            If .Cells(3, c) Like Arr(i) Then .Cells(4000, c) = "x"
        Next
    Next
    For c = cll.Columns.Count To 2 Step -1
       If .Cells(4000, c) <> "x" Then .Cells(3, c).EntireColumn.Delete
    Next
    .Range("A4000:AW4000").ClearContents
    .Select
End With
Erase Arr

End Sub

 

[sep_hatxel]

Bạn dùng code sau nhé:

Sub test1()
Dim Arr As Variant, i As Integer, c As Integer, cll As Range
With Sheet2
    Sheet1.Range("A1:AW4000").Copy .[a1]
    Set cll = .Range("B3:AX3")
    Arr = Split(.[a1], ",")
    For i = LBound(Arr) To UBound(Arr)
        For c = cll.Columns.Count To 2 Step -1
            If .Cells(3, c) Like Arr(i) Then .Cells(4000, c) = "x"
        Next
    Next
    For c = cll.Columns.Count To 2 Step -1
       If .Cells(4000, c) <> "x" Then .Cells(3, c).EntireColumn.Delete
    Next
    .Range("A4000:AW4000").ClearContents
    .Select
End With
Erase Arr

End Sub

Vâng! Cảm ơn thầy Hai Lúa Miền Tây rất nhiều ạ, cảm ơn GPE!

 

[TrungChinhs]

Bạn thử thêm code này xem.
Muốn xóa hoặc Copy cột nào thì bạn đánh dấu (ví dụ x) vào dòng trên cột đó (mỗi loại ký hiệu chỉ đánh 1 lần) rồi chạy Sub DelColumn hoặc Sub CopyColumn

Sub Check()
    For Each cls In [b3].Resize(, 200).SpecialCells(2)
        For Each clsx In [b2].Resize(, 200).SpecialCells(2)
            If cls = clsx(2) Then cls(0) = "x"
        Next
    Next
End Sub

Sub DelColumn()
    Call Check
    [b2].Resize(, 200).SpecialCells(2).EntireColumn.Delete
End Sub

Sub CopyColumn()
    Call Check
    ActiveSheet.UsedRange.Copy Sheets("sheet2").[a1]
    With Sheets("sheet2").[b2].Resize(, 200)
        .SpecialCells(4).EntireColumn.Delete
        .ClearContents
    End With
End Sub