Thu xem. Hay thay doi o C2 va xem ket quaNhờ a / c lọc sheet sang giúp dữ liệu bằng VBA.
do yêu cầu lọc sang sheet và copy sang sheet khác hiển thị một số cột cần thiết thôi.
Bạn nên thêm hàm Ucase chỗ biến DK và so sánh mã số phòng trường hợp gõ Vp thì không có kết quả.Thu xem. Hay thay doi o C2 va xem ket qua
If t Then Sheet2.[A5].Resize(t, 10) = KQ
Sheet2.[H5].Resize(t).NumberFormat = "mm/dd/yyyy"
If t Then
Sheet2.[A5].Resize(t, 10) = KQ
Sheet2.[H5].Resize(t).NumberFormat = "mm/dd/yyyy"
end if
A cho e xin file đã sửa lại như trên giúpBạn nên thêm hàm Ucase chỗ biến DK và so sánh mã số phòng trường hợp gõ Vp thì không có kết quả.
Và chỗ
sửa thànhMã:If t Then Sheet2.[A5].Resize(t, 10) = KQ Sheet2.[H5].Resize(t).NumberFormat = "mm/dd/yyyy"
Chứ nếu t=0 thì dòng Sheet2.[H5].Resize(t).NumberFormat = "mm/dd/yyyy" bị lỗiMã:If t Then Sheet2.[A5].Resize(t, 10) = KQ Sheet2.[H5].Resize(t).NumberFormat = "mm/dd/yyyy" end if
Code đã sửa:A cho e xin file đã sửa lại như trên giúp
Sub LOC()
Dim j&, Lr&, t&, k&
Dim Arr(), S, tmp, DK
Lr = Sheet1.Cells(Rows.Count, 1).End(3).Row
Arr = Sheet1.Range("A4:P" & Lr).Value
ReDim KQ(1 To UBound(Arr), 1 To 10)
DK = UCase(Sheet2.Cells(2, 3))
For j = 1 To UBound(Arr)
If UCase(Arr(j, 5)) = DK Then
t = t + 1
KQ(t, 1) = t
For k = 2 To 7
KQ(t, k) = Arr(j, k)
Next k
KQ(t, 8) = Arr(j, 12)
KQ(t, 9) = Arr(j, 14)
KQ(t, 10) = Arr(j, 15)
End If
Next j
If t Then
Sheet2.[A5].Resize(t, 10) = KQ
Sheet2.[H5].Resize(t).NumberFormat = "mm/dd/yyyy"
End If
End Sub
Cám ơn bạn nhiềuCode đã sửa:
Rich (BB code):Sub LOC() Dim j&, Lr&, t&, k& Dim Arr(), S, tmp, DK Lr = Sheet1.Cells(Rows.Count, 1).End(3).Row Arr = Sheet1.Range("A4:P" & Lr).Value ReDim KQ(1 To UBound(Arr), 1 To 10) DK = UCase(Sheet2.Cells(2, 3)) For j = 1 To UBound(Arr) If UCase(Arr(j, 5)) = DK Then t = t + 1 KQ(t, 1) = t For k = 2 To 7 KQ(t, k) = Arr(j, k) Next k KQ(t, 8) = Arr(j, 12) KQ(t, 9) = Arr(j, 14) KQ(t, 10) = Arr(j, 15) End If Next j If t Then Sheet2.[A5].Resize(t, 10) = KQ Sheet2.[H5].Resize(t).NumberFormat = "mm/dd/yyyy" End If End Sub
Làm sao để xoá kết quả cũ (lọc điều kiện trước vậy bạn).Cám ơn bạn nhiều
Thử codeCám ơn bạn nhiều
Bài đã được tự động gộp:
Làm sao để xoá kết quả cũ (lọc điều kiện trước vậy bạn).
Sub ABC()
Dim Arr(), Res(), i&, BP$, K&, X&
With Sheets("DATA")
Arr = .Range("A4:O" & .Range("B" & Rows.Count).End(3).Row).Value
End With
BP = Sheets("L-BO PHAN").Range("C2").Value
ReDim Res(1 To UBound(Arr, 1), 1 To 10)
For i = 1 To UBound(Arr, 1)
If Arr(i, 5) = BP Then
K = K + 1
Res(K, 1) = K
For X = 2 To 7
Res(K, X) = Arr(i, X)
Next
Res(K, 8) = Arr(i, 12)
Res(K, 9) = Arr(i, 14)
Res(K, 10) = Arr(i, 15)
End If
Next
With Sheets("L-BO PHAN")
.Range("A5:J1000").ClearContents
If K Then .Range("A5").Resize(K, 10).Value = Res
End With
End Sub
Try codeMã:Sub ABC () Dim Arr (), Res (), i &, BP $, K &, X & Với Trang tính ("DỮ LIỆU") Arr = .Range ("A4: O" & .Range ("B" & Rows.Count) .End (3) .Row). Giá trị Kết thúc với BP = Trang tính ("L-BO PHAN"). Phạm vi ("C2"). Giá trị ReDim Res (1 đến UBound (Arr, 1), 1 đến 10) Đối với i = 1 Đến UBound (Arr, 1) Nếu Arr (i, 5) = BP Thì K = K + 1 Res (K, 1) = K Đối với X = 2 đến 7 Res (K, X) = Arr (i, X) Kế tiếp Res (K, 8) = Arr (i, 12) Res (K, 9) = Arr (i, 14) Res (K, 10) = Arr (i, 15) Kết thúc nếu Kế tiếp Với Trang tính ("L-BO PHAN") .Range ("A5: J1000"). ClearContents If K Then .Range ("A5"). Thay đổi kích thước (K, 10) .Value = Res Kết thúc với Kết thúc Sub [/MÃ SỐ] [/QUOTE] Vâng cám ơn bạn đã giúp rất nhiều, mình mới chạy thử thấy ổn
Cảm ơn anh đã chỉ giáo và cho tôi một kinh nghiệm quý báu.Bạn nên thêm hàm Ucase chỗ biến DK và so sánh mã số phòng trường hợp gõ Vp thì không có kết quả.
Và chỗ
sửa thànhMã:If t Then Sheet2.[A5].Resize(t, 10) = KQ Sheet2.[H5].Resize(t).NumberFormat = "mm/dd/yyyy"
Chứ nếu t=0 thì dòng Sheet2.[H5].Resize(t).NumberFormat = "mm/dd/yyyy" bị lỗiMã:If t Then Sheet2.[A5].Resize(t, 10) = KQ Sheet2.[H5].Resize(t).NumberFormat = "mm/dd/yyyy" end if
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [C2]) Is Nothing Then
Rows("5:1000").Clear
Sheet1.[B3:Q10000].AdvancedFilter 2, [C1:C2], [B4:J4]
[A4].CurrentRegion.Borders.Value = 1
If [B5] <> "" Then Range([B5], [B65536].End(3)).Offset(, -1) = [row(a:a)]
End If
End Sub
Gửi lại bạn File đã sửa code theo gợi ý của anh Maika8008. Trong file đã làm thêm cho bạn Data validation ở ô C2. khi click chọn kết quả sẽ được thể hiện bên dưới.Cám ơn bạn nhiều
Bài đã được tự động gộp:
Làm sao để xoá kết quả cũ (lọc điều kiện trước vậy bạn).
Anh cho hỏi, giờ muốn thay đổi cột lọc dữ liệu thì mình phải sửa code như thế nào (e tùy biến theo dữ liệu của mình).Gửi lại bạn File đã sửa code theo gợi ý của anh Maika8008. Trong file đã làm thêm cho bạn Data validation ở ô C2. khi click chọn kết quả sẽ được thể hiện bên dưới.
Với File bài #10Anh cho hỏi, giờ muốn thay đổi cột lọc dữ liệu thì mình phải sửa code như thế nào (e tùy biến theo dữ liệu của mình).
Giả sử em lọc cột Trình độ NV.
Cám ơn
Taọ 01 validation rồi sửa đoạn này!Anh cho hỏi, giờ muốn thay đổi cột lọc dữ liệu thì mình phải sửa code như thế nào (e tùy biến theo dữ liệu của mình).
Giả sử em lọc cột Trình độ NV.
Cám ơn
Dùng mảng để lọc với bài này là giải pháp tốt, tuy nhiên mà tác giả muốn đảo vị trí các cột kết quả, bổ sung thêm trường và một vài điều kiện lọc nữa thì sửa code cũng khá nhọc.Taọ 01 validation rồi sửa đoạn này!
If Arr(j, 9) = DK Then Thay số 5 thành số 9.
Em còn một vấn đề nữa là nếu điều kiện lọc là số thì không ra được kết quả, không chạy được.Taọ 01 validation rồi sửa đoạn này!
If Arr(j, 9) = DK Then Thay số 5 thành số 9.
bạn muốn lọc gì? bạn gửi yêu cầu lên đi.Em còn một vấn đề nữa là nếu điều kiện lọc là số thì không ra được kết quả, không chạy được.
Vì máy dùng chung nhiều người, một số thì biết chút ít excel nên lọc thủ công được, số còn lại không làm được, nên e trích lọc sang sheet khác là vậy. E dùng công thức nhưng chạy chậm quá nên nhờ giúp VBA.
Trân trọng cám ơn
Yêu cầu của bạn cụ thể như thế nào?Em còn một vấn đề nữa là nếu điều kiện lọc là số thì không ra được kết quả, không chạy được.
Vì máy dùng chung nhiều người, một số thì biết chút ít excel nên lọc thủ công được, số còn lại không làm được, nên e trích lọc sang sheet khác là vậy. E dùng công thức nhưng chạy chậm quá nên nhờ giúp VBA.
Trân trọng cám ơn