Lọc dữ liệu sản phẩm có giá trị âm (1 người xem)

  • Thread starter Thread starter vukody
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

vukody

Thành viên mới
Tham gia
16/2/12
Bài viết
5
Được thích
1
Em có 1 bảng sản phẩm có những số lượng âm và dương, nay em muốn lọc nhứng sản phẩm có số lượng âm sang 1 sheet khác để báo cáo tình hình. Mong các anh chị giúp em. Thk
 
Em có 1 bảng sản phẩm có những số lượng âm và dương, nay em muốn lọc nhứng sản phẩm có số lượng âm sang 1 sheet khác để báo cáo tình hình. Mong các anh chị giúp em. Thk
1. Cách 1: Sử dụng cột phụ và công thức (trên sheet Dung cong thuc):
- Sử dụng công thức sau cho ô D5 trên sheet dữ liệu ban đầu và fill cho toàn cột:
Mã:
=IF(C5<0,MAX(D$4:D4)+1,"")
- Sử dụng công thức sau cho ô A2 trên sheet kết quả lọc và fill cho toàn bảng:
Mã:
=IF(ROW(1:1)>MAX('DL ban dau'!$D:$D),"",INDEX('DL ban dau'!A$5:A$10000,MATCH(ROW(1:1),'DL ban dau'!$D$5:$D$10000,0)))
---> Cách này thủ công và nặng nề vì cần dùng cột phụ và có thể vùng chứa công thức lại không có dữ liệu.
2. Cách 2: Sử dụng code VBA (trên sheet Dung code): Sử dụng code sau cho sheet kết quả lọc:
PHP:
Private Sub Worksheet_Activate()
    UsedRange.Clear
    Sheet1.[4:4].Copy [A1]
    [IV2].FormulaR1C1 = "='" & Sheet1.Name & "'!R[3]C3<0"
    Sheet1.[A4].CurrentRegion.AdvancedFilter xlFilterCopy, [IV1:IV2], [A1].CurrentRegion
    [IV2].Clear
End Sub
---> Cách này tự động và không cần quan tâm bảng dữ liệu ban đầu có bao nhiêu dòng, cột, chỉ cần mỗi lần chọn sheet Dung code thì sẽ nhận được kết quả lọc. Hơn nữa sẽ không có chứa công thức nào cả nên file sẽ nhẹ. Tuy nhiên phải nhớ Enable macro và lưu file với định dạng thích hợp (.xlsm hoặc .xls).
 

File đính kèm

Mấy ngày theo dõi các bài viết về mảng "quá đã", thấy bài này cũng có thể dùng mảng nên làm như một bài tập.
Nếu thấy còn có gì đó cần "túm gọn" nữa thì xin các bạn góp ý.
 

File đính kèm

Mấy ngày theo dõi các bài viết về mảng "quá đã", thấy bài này cũng có thể dùng mảng nên làm như một bài tập. Nếu thấy còn có gì đó cần "túm gọn" nữa thì xin các bạn góp ý.
Code của bạn là:
PHP:
Public Sub GPE()
  Application.ScreenUpdating = False
  Dim nn As Long, i As Long, k As Long, Rngs(), Arr()
  nn = Sheet1.[A65000].End(xlUp).Row
  Rngs = Sheet1.Range("A5:C" & nn)
  ReDim Arr(1 To nn - 4, 1 To 3)
  For i = 1 To nn - 4
    If Rngs(i, 3) < 0 Then
      k = k + 1
      Arr(k, 1) = Rngs(i, 1)
      Arr(k, 2) = Rngs(i, 2)
      Arr(k, 3) = Rngs(i, 3)
    End If
  Next
  With Sheet3
    .Range([A5], [A5].End(xlDown)).Resize(, 3).Clear
    .Range("A5:C" & k + 4).Value = Arr
    .Range("A4:C" & k + 4).Borders.LineStyle = xlContinuous
  End With
End Sub
Giải thuật thì đúng nhưng thể hiện thì chưa chặt chẽ lắm
Tôi nghĩ phải là vầy:
PHP:
Public Sub GPE()
  Application.ScreenUpdating = False
  Dim i As Long, k As Long, Rngs(), Arr()
  On Error Resume Next
  Rngs = Sheet1.Range("A5:C65000").Value
  ReDim Arr(1 To UBound(Rngs, 1), 1 To 3)
  For i = 1 To UBound(Rngs, 1)
    If Rngs(i, 3) < 0 Then
      k = k + 1
      Arr(k, 1) = Rngs(i, 1)
      Arr(k, 2) = Rngs(i, 2)
      Arr(k, 3) = Rngs(i, 3)
    End If
  Next
  If k Then
    With Sheet3
      .Range("A5:C60000").ClearContents
      .Range("A5").Resize(k, 3).Value = Arr
    End With
  End If
  Application.ScreenUpdating = True
End Sub
Tôi góp ý vài chổ:
- Bạn đã chuyển dữ liệu dạng Range sang mảng (biến Rngs), vậy thì cứ "bám" vào biến Rngs này mà triển khai, sao lại có vụ For i = 1 To nn - 4 (bị lệ thuộc vào dữ liệu nguồn) ---> Nếu dữ liệu nguồn không phải bắt đầu từ dòng 4 chẳng hóa ra phải sửa code sao?
- Tương tự điều này đối với ReDim
- Phần cuối code (xuất dữ liệu) cũng nên có 1 cái IF để bẫy lỗi ---> Lở như dữ liệu toàn >0 sẽ dẫn đến code bị lỗi
- Application.ScreenUpdating = False đặt ở trên thì phải trả nó về =True cuối code
- Với mảng thì thậm chí cũng không cần đến End(xlUp) làm gì ---> Ước lượng kích thước mảng dư 1 chút cũng không sao
- Dù là không còn lỗi gì nữa thì cũng nên cho đoạn On Error Resume Next lên đầu code để phòng ngừa
Góp ý này dựa vào kinh nghiệm của tôi khi làm việc với mảng, mong bạn đừng giận và cố gắng thêm nữa
 
Lần chỉnh sửa cuối:
Web KT

Bài viết mới nhất

Back
Top Bottom