Rút trích dữ liệu có điều kiện bằng VBA (3 người xem)

[kokano90]

Chào các anh chị ạ
Hiện tại em có file như đính kèm
Gồm 3 sheet : Input, Graph, aid
Em muốn lọc dữ liệu của sheet "Input" dựa vào điều kiện ô B1 của sheet " Graph"
Sau khi lọc xong thì copy dữ liệu sang sheet "aid"
Nhờ các anh chị giúp em với ạ

 

[kokano90]

Có anh chị, thầy cô nào có cách giải quyết nào giúp em với ạ

 

[HieuCD]

Chào các anh chị ạ
Hiện tại em có file như đính kèm
Gồm 3 sheet : Input, Graph, aid
Em muốn lọc dữ liệu của sheet "Input" dựa vào điều kiện ô B1 của sheet " Graph"
Sau khi lọc xong thì copy dữ liệu sang sheet "aid"
Nhờ các anh chị giúp em với ạ

Chạy code

Sub Loc()
  Dim sArr(), Res(), i&, k&, j&, sRow&, sCol&, SP$
 
  Application.ScreenUpdating = False
  With Sheets("aid")
    i = .Range("D" & Rows.Count).End(xlUp).Row
    If i > 12 Then .Range("D13:BN" & i).ClearContents
  End With
  SP = Sheets("graph").Range("B1")
  If Len(SP) = 0 Then MsgBox ("Ma San Pham chua nhap"): Exit Sub
  With Sheets("input")
    If .AutoFilterMode = True Then .AutoFilterMode = False
    i = .Range("D" & Rows.Count).End(xlUp).Row
    If i < 6 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("D6:BN" & i).Value
  End With
  sRow = UBound(sArr, 1): sCol = UBound(sArr, 2)
  ReDim Res(1 To sRow, 1 To sCol)
  For i = 1 To sRow
    If SP = sArr(i, 1) Then
      k = k + 1
      Res(k, 1) = k
      For j = 2 To sCol
        Res(k, j) = sArr(i, j)
      Next j
    End If
  Next i
 
  With Sheets("aid")
    If k Then .Range("D13:BN13").Resize(k) = Res
  End With
  Application.ScreenUpdating = True
End Sub

 

[kokano90]

Chạy code

Cám ơn anh rất nhiều ạ. cho em hỏi thêm 1 chút. có cách nào để nó tự cập nhật không ạ. để ở sự kiện activate sheets aid thì nó chạy đoạn code trên được không ạ

 

[kokano90]

Anh @HieuCD ơi. Còn trường hợp B1 của sheets(graph) là ALL thì nó không lấy được dữ liệu ạ

 

[HieuCD]

Anh @HieuCD ơi. Còn trường hợp B1 của sheets(graph) là ALL thì nó không lấy được dữ liệu ạ

Tạo sự kiện chạy sub Loc
Nhập "ALL" lấy tất cả

Sub Loc()
  Dim sArr(), Res(), i&, k&, j&, sRow&, sCol&, SP$, dkBln As Boolean
  Application.ScreenUpdating = False
  With Sheets("aid")
    i = .Range("D" & Rows.Count).End(xlUp).Row
    If i > 12 Then .Range("D13:BN" & i).ClearContents
  End With
  SP = Sheets("graph").Range("B1")
  If Len(SP) = 0 Then
    MsgBox ("Ma San Pham chua nhap"): Exit Sub
  Else
    If UCase(SP) = "ALL" Then dkBln = True
  End If
  With Sheets("input")
    If .AutoFilterMode = True Then .AutoFilter.ShowAllData
    i = .Range("D" & Rows.Count).End(xlUp).Row
    If i < 6 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("D6:BN" & i).Value
  End With
  sRow = UBound(sArr, 1): sCol = UBound(sArr, 2)
  ReDim Res(1 To sRow, 1 To sCol)
  For i = 1 To sRow
    If SP = sArr(i, 1) Or dkBln Then
      k = k + 1
      Res(k, 1) = k
      For j = 2 To sCol
        Res(k, j) = sArr(i, j)
      Next j
    End If
  Next i

  With Sheets("aid")
    If k Then .Range("D13:BN13").Resize(k) = Res
  End With
  Application.ScreenUpdating = True
End Sub

 

[kokano90]

@HieuCD Cám ơn anh rất nhiều ạ