Sử dụng VBA để lọc dữ liệu

[Ngoc Tam]

Precondition:
1. Mình đã biết cách lọc dữ liệu dùng chức năng Filter Advanced.
2.Mình đã lấy Button control ra bảng tính.
3.Mình có biết VBA sơ sơ (ví dụ mình biết viết VBA cho button khi click vào button thì tăng ngày của ô hiện tại lên 1 - mình tham khảo ví dụ này trên diễn dàn)

Nhờ giúp đỡ:
Nhờ các bạn chỉ cách viết VBA cho button, khi mình click lên button thì sẽ thực hiện chức năng filter.

Cám ơn các bạn.

 

[MinhNguyệt]

Precondition:
1. Mình đã biết cách lọc dữ liệu dùng chức năng Filter Advanced.
2.Mình đã lấy Button control ra bảng tính.
3.Mình có biết VBA sơ sơ (ví dụ mình biết viết VBA cho button khi click vào button thì tăng ngày của ô hiện tại lên 1 - mình tham khảo ví dụ này trên diễn dàn)

Nhờ giúp đỡ:
Nhờ các bạn chỉ cách viết VBA cho button, khi mình click lên button thì sẽ thực hiện chức năng filter.

Cám ơn các bạn.

Gán macro này vào cho nút Xuất hóa đơn nè

Sub Loc()
    Sheet1.Range("B10:D100").Clear
    Sheet1.Range("B1:D6").AdvancedFilter xlFilterCopy, Range("F1:F2"), Range("B10")
End Sub

Hoặc gán cái này

Sub Loc()
    With Sheet1
        .Range("B10:D100").Clear
        .Range("B1").AutoFilter 3, ">0"
        .Range("B1").CurrentRegion.Copy Destination:=.Range("B10")
        .Range("B1").AutoFilter
    End With
End Sub

 

[usnex]

NgocTam cho mình mượn tạm topic của bạn nhé. Thanks.

Nhờ các anh chị viết giúp em VBA để lọc data từ sheet1 sang sheet2 như sau:
Ô A1 =Sheet1!A1, B1 =Sheet1!A2, C1 =Sheet1!A3, D1 =Sheet1!A4 ...
A2 =Sheet1!C1, B2 =Sheet1!C2, C2 =Sheet1!C3, D2 =Sheet1!C4 ...
A3 =Sheet1!E1, B3 =Sheet1!E2, C3 =Sheet1!E3, D3 =Sheet1!E4 ...
(data được copy cách dòng tuần tự như vậy cho đến hết).

Mong các anh chị giúp đỡ. Cảm ơn rất nhiều.
Vui lòng xem ví dụ đính kèm.

 

[MinhNguyệt]

NgocTam cho mình mượn tạm topic của bạn nhé. Thanks.

Nhờ các anh chị viết giúp em VBA để lọc data từ sheet1 sang sheet2 như sau:
Ô A1 =Sheet1!A1, B1 =Sheet1!A2, C1 =Sheet1!A3, D1 =Sheet1!A4 ...
A2 =Sheet1!C1, B2 =Sheet1!C2, C2 =Sheet1!C3, D2 =Sheet1!C4 ...
A3 =Sheet1!E1, B3 =Sheet1!E2, C3 =Sheet1!E3, D3 =Sheet1!E4 ...
(data được copy cách dòng tuần tự như vậy cho đến hết).

Mong các anh chị giúp đỡ. Cảm ơn rất nhiều.
Vui lòng xem ví dụ đính kèm.

Việc này đâu cần phải VBA? Copy cả Sheet dán qua rồi dùng chức năng chuyển hàng thành cột là được mà.

Còn nếu muốn dùng VBA thì chép code này vào module và chạy nó

Sub Copy()
    Dim i As Integer, j As Integer, m As Integer, n As Integer
    m = 8
    n = 11
    For i = 1 To m
        For j = 1 To n
            Sheet2.Cells(j, i) = Sheet1.Cells(i, j)
        Next
    Next
End Sub

P/S : Bạn thay đổi m và n theo yêu cầu
Thân

 

[ndu96081631]

NgocTam cho mình mượn tạm topic của bạn nhé. Thanks.

Nhờ các anh chị viết giúp em VBA để lọc data từ sheet1 sang sheet2 như sau:
Ô A1 =Sheet1!A1, B1 =Sheet1!A2, C1 =Sheet1!A3, D1 =Sheet1!A4 ...
A2 =Sheet1!C1, B2 =Sheet1!C2, C2 =Sheet1!C3, D2 =Sheet1!C4 ...
A3 =Sheet1!E1, B3 =Sheet1!E2, C3 =Sheet1!E3, D3 =Sheet1!E4 ...
(data được copy cách dòng tuần tự như vậy cho đến hết).

Mong các anh chị giúp đỡ. Cảm ơn rất nhiều.
Vui lòng xem ví dụ đính kèm.

Dùng công thức này thử (gõ vào cell A1 của sheet 2 nhé)

=INDEX(Sheet1!$A$1:$K$8,COLUMNS($A:A),ROWS($1:1)*2-1)

Kéo fill sang phải và xuống dưới

 

[usnex]

Mình đã dùng INDEX và thực hiện được rồi. Cảm ơn ndu96081631 nhiều.
@MinhNguyet: mình đã dùng chức năng chuyển hàng thành cột nhưng do data muốn copy không liên tục (chỉ copy cột data tô màu xanh) nên phải copy&paste và tranpose từng dòng một mất nhiều thời gian. Mình gửi lại file (một phần của Bcáo thực tế) nhờ MinhNguyet xem viết lại VBA như thế nào nhé? Mình không rành VBA nhưng đang cố gắng tìm hiểu, nhờ MinhNguyêt xem giúp. Cảm ơn rất nhiều.

 

[ndu96081631]

Mình đã dùng INDEX và thực hiện được rồi. Cảm ơn ndu96081631 nhiều.
@MinhNguyet: mình đã dùng chức năng chuyển hàng thành cột nhưng do data muốn copy không liên tục (chỉ copy cột data tô màu xanh) nên phải copy&paste và tranpose từng dòng một mất nhiều thời gian. Mình gửi lại file (một phần của Bcáo thực tế) nhờ MinhNguyet xem viết lại VBA như thế nào nhé? Mình không rành VBA nhưng đang cố gắng tìm hiểu, nhờ MinhNguyêt xem giúp. Cảm ơn rất nhiều.

Tại cell E2 của sheet1, gõ vào công thức này xem:

=INDEX(Data!$B$4:$AY$12,MATCH(E$1,Data!$A$4:$A$12,0),MOD(ROWS($1:1)-1,2)+1+INT((ROWS($1:1)-1)/2)*6)

Kéo fill sang phải và xuống dưới

 

[SA_DQ]

Xem thêm trong file kèm theo

Mình gửi lại file (một phần của Bcáo thực tế) nhờ MinhNguyet xem viết lại VBA như thế nào nhé? Mình không rành VBA nhưng đang cố gắng tìm hiểu, nhờ MinhNguyêt xem giúp. Cảm ơn rất nhiều.

Cho phép chen chưn 1 cái:

Option Explicit
Dim Sh As Worksheet
Sub TransCopy()
 Dim Thg As Byte:                         Dim eRw As Long
 
 Sheets("Data").Select:                   eRw = [A65500].End(xlUp).Row
 Set Sh = Sheets("S2"):                   Sh.[e2].Resize(eRw, eRw).ClearContents:
 Range("A4:A" & eRw).Copy
 CopyTransOneTime Sh.[e1]                 ' TransCopy header'
 For Thg = 0 To 11
   Cells(4, 2 + 6 * Thg).Resize(eRw).Copy
   CopyTransOneTime Sh.Cells(2 + Thg, "E")
 Next Thg
 Application.CutCopyMode = False
End Sub

[B]Sub CopyTransOneTime(Rng As Range)[/B]
   Rng.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, Transpose:=True
[B]End Sub[/B]

 

[usnex]

@ ndu96081631: nhờ anh ndu96081631 kiểm tra lại công thức giúp mình với, kết quả không đúng như yêu cầu (cột Plan và Actual xen kẽ chứ không liên tục với nhau).

Thanks.

 

[usnex]

@ HYen17: mình đã copy VBA như hướng dẫn nhưng data chỉ copy cột Plan mà không copy cột Actual. Mình đã thử chèn thêm một module nữa để copy cột Actual nhưng chỉ đạt kết quả khi thực hiện lệnh ở sheet mới, không thực hiện được trong cùng một sheet (file đính kèm). HYen17 hướng dẫn giúp nhé. Cảm ơn.

 

[SA_DQ]

@ HYen17: mình đã copy VBA như hướng dẫn nhưng data chỉ copy cột Plan mà không copy cột Actual. Mình đã thử chèn thêm một module nữa để copy cột Actual nhưng chỉ đạt kết quả khi thực hiện lệnh ở sheet mới, không thực hiện được trong cùng một sheet (file đính kèm). HYen17 hướng dẫn giúp nhé. Cảm ơn.

À mình cũng chưa nhìn thật kỹ hết yêu cầu, rất xin lỗi bạn;

Macro phải thêm 1 vòng lặp nữa, như sau:

Option Explicit
Dim Sh As Worksheet
Sub TransCopy()
 Dim Thg As Byte:                         Dim eRw As Long
 
 Sheets("Data").Select:                   eRw = [A65500].End(xlUp).Row
 Set Sh = Sheets("S2"):                   Sh.[e2].Resize(eRw, eRw).ClearContents:
 Application.ScreenUpdating = False:      Range("A4:A" & eRw).Copy
 CopyTransOneTime Sh.[e1]                 ' TransCopy header'
 For Thg = 0 To 11
   Cells(4, 2 + 6 * Thg).Resize(eRw).Copy
   CopyTransOneTime Sh.Cells(2 + Thg, "E")
 Next Thg
'  *     *  *     *     *     *  *     *'
 For Thg = 11 To 22 
   Cells(4, 3 + 6 * (Thg - 11)).Resize(eRw).Copy
   CopyTransOneTime Sh.Cells(Thg, "E")
 Next Thg
'  *     *  *     *     *     *  *     *'
 Application.CutCopyMode = False:         Sh.Select
End Sub

Còm macro thứ hai vẫn như cũ nha!

(Có thêm dòng lệnh để khỏi lắc lư màn hình

 

[usnex]

Cảm ơn HYen17 rất nhiều.
(Đúng là màn hình có lắc lư thiệt!!)