Xoá tất cả các dòng & cột. Chỉ giữ lại một số dòng có điều kiện (1 người xem)

[hanphilong103]

Chào mọi người,

Em có file ẽxcel chứa số liệu như file đính kèm.

Giờ em muốn xoá hết tất cả các dòng & cột. Chỉ giữ lại những dòng & cột có tiêu đề cố định
Chỉ giữ lại những cột có tiêu đề: 2014,2013,2012,2012.
& dòng có tiêu đề: b,c,d,e

Xong đảo cột số liệu & copy pass sang Sheet 2. Dữ liệu Sheet 1 dữ nguyên.

Anh/chị nào sử dụng VBA có thể giúp với.

Thanks

 

[Let'GâuGâu]

Chào mọi người,

Em có file ẽxcel chứa số liệu như file đính kèm.

Giờ em muốn xoá hết tất cả các dòng & cột. Chỉ giữ lại những dòng & cột có tiêu đề cố định
Chỉ giữ lại những cột có tiêu đề: 2014,2013,2012,2012.
& dòng có tiêu đề: b,c,d,e

Xong đảo cột số liệu & copy pass sang Sheet 2. Dữ liệu Sheet 1 dữ nguyên.

Anh/chị nào sử dụng VBA có thể giúp với.

Thanks

Sub Quaybanhtinh()
Dim bang, ver, hor, yr, kytu, kq As Variant, i, j, k As Long
 With Sheet1
  bang = .[a1].CurrentRegion
  ver = .Range(.[a1], .[a1].End(4)).Value
  hor = .Range(.[a1], .[a1].End(2)).Value
End With
  yr = Array(2015, 2014, 2013, 2012)
  kytu = Array("b", "c", "e", "d")

    For i = 2 To UBound(hor, 2)
        col = Application.Match(hor(1, i), yr, 0)
        If TypeName(col) = "Error" Then bang(1, i) = ""
    Next
    
    For j = 2 To UBound(ver)
       rw = Application.Match(ver(j, 1), kytu, 0)
        If TypeName(rw) = "Error" Then bang(j, 1) = ""
    Next j
Application.ScreenUpdating = False
With Sheet2
    .[a1].CurrentRegion.Clear
    .[a1].Resize(UBound(bang, 2), UBound(bang)) = Application.Transpose(bang)
    .[a1].Resize(, UBound(bang)).SpecialCells(4).EntireColumn.Delete
    .[a1].Resize(UBound(bang, 2)).SpecialCells(4).EntireRow.Delete
 End With
Application.ScreenUpdating = True
End Sub

 

[hanphilong103]

Sub Quaybanhtinh()
Dim bang, ver, hor, yr, kytu, kq As Variant, i, j, k As Long
 With Sheet1
  bang = .[a1].CurrentRegion
  ver = .Range(.[a1], .[a1].End(4)).Value
  hor = .Range(.[a1], .[a1].End(2)).Value
End With
  yr = Array(2015, 2014, 2013, 2012)
  kytu = Array("b", "c", "e", "d")

    For i = 2 To UBound(hor, 2)
        col = Application.Match(hor(1, i), yr, 0)
        If TypeName(col) = "Error" Then bang(1, i) = ""
    Next
    
    For j = 2 To UBound(ver)
       rw = Application.Match(ver(j, 1), kytu, 0)
        If TypeName(rw) = "Error" Then bang(j, 1) = ""
    Next j
Application.ScreenUpdating = False
With Sheet2
    .[a1].CurrentRegion.Clear
    .[a1].Resize(UBound(bang, 2), UBound(bang)) = Application.Transpose(bang)
    .[a1].Resize(, UBound(bang)).SpecialCells(4).EntireColumn.Delete
    .[a1].Resize(UBound(bang, 2)).SpecialCells(4).EntireRow.Delete
 End With
Application.ScreenUpdating = True
End Sub

Cảm ơn bạn.

Nếu kết quả này không cần xuất sang sheet mà chỉ xuất ở sheet1 thôi. & code chạy cho tất cả các sheet trong file thì sửa lại code như thế nào vậy bạn.

 

[doveandrose]

Cảm ơn bạn.

Nếu kết quả này không cần xuất sang sheet mà chỉ xuất ở sheet1 thôi. & code chạy cho tất cả các sheet trong file thì sửa lại code như thế nào vậy bạn.

có làm cho bạn xong rồi bạn cũng không xài được . vì vẫn còn phải chèn thêm cột A làm tên sheet nữa như yêu cầu của bạn ở đây

http://www.giaiphapexcel.com/forum/showthread.php?107040-Insert-một-cột-lấy-tên-sheet

vậy hà tất phải đi làm phiền người khác như vậy ?