Lẫy dữ liệu excel theo điều kiện (2 người xem)

[zine]

Hi các anh chị
Em muốn lấy dữ liệu theo từng cấp điều kiện. Chi tiết như file đính kèm
Anh chị giúp em nhé
Cảm ơn rất nhiều

 

[zine]

Em up lên

 

[snow25]

Em up lên

Bạn sắp xếp giao diện để hiện thị không hợp lý.Nên không ai code đâu.Vì khi trả kết quả nó sẽ chèn hết vào dữ liệu gốc.

 

[zine]

Bạn sắp xếp giao diện để hiện thị không hợp lý.Nên không ai code đâu.Vì khi trả kết quả nó sẽ chèn hết vào dữ liệu gốc.

Ý anh là bảng dữ liệu chi tiết. Híc, em để nó cho dễ tham chiếu thôi, khi thực hiện Bảng dữ liệu chi tiết sẽ ở một sheet khác

 

[snow25]

Ý anh là bảng dữ liệu chi tiết. Híc, em để nó cho dễ tham chiếu thôi, khi thực hiện Bảng dữ liệu chi tiết sẽ ở một sheet khác

Vậy bạn đăng cái kia lên đi.Mình code vào đấy.

 

[zine]

Vậy bạn đăng cái kia lên đi.Mình code vào đấy.

Cảm ơn bản. Mình up bản yêu cầu đầy đủ nhé, trong đó mình có comment cho rõ các mong muốn

 

[snow25]

Cảm ơn bản. Mình up bản yêu cầu đầy đủ nhé, trong đó mình có comment cho rõ các mong muốn

Đây bạn xem.

Sub ketqua()
Dim arr, arr1
Dim a As Long, b As Long, c As Long, i As Long, j As Long, lr As Long, k As Long
Dim dk As String, dks As String, T, aT, aso()
With Sheets("du lieu")
     lr = .Range("C" & Rows.Count).End(xlUp).Row
     If lr < 5 Then MsgBox "khong co du lieu": Exit Sub
     arr = .Range("C5:R" & lr).Value
     ReDim arr1(1 To UBound(arr, 1), 1 To 16)
End With
With Sheet1
     T = Array(.Range("E7").Value, .Range("E8").Value, .Range("E9").Value, .Range("E10").Value)
     aT = Array(1, 2, 3, 4)
     If Len(.Range("e7").Value) = 0 Then MsgBox "chon muc 1": Exit Sub
     For i = LBound(T) To UBound(T)
         If T(i) <> Empty Then
            c = c + 1
            If dk = Empty Then
               dk = T(i)
            Else
               dk = dk & "#" & T(i)
            End If
           ReDim Preserve aso(1 To c)
           aso(c) = aT(i)
         End If
    Next i
    For i = 1 To UBound(arr, 1)
        dks = Empty
        For k = LBound(aso) To UBound(aso)
            If dks = Empty Then
               dks = arr(i, aso(k))
            Else
               dks = dks & "#" & arr(i, aso(k))
            End If
        Next k
     If Len(arr(i, 2)) > 0 Then
     If UCase(dk) = UCase(dks) Then
        a = a + 1
        For j = 1 To 16
            arr1(a, j) = arr(i, j)
        Next j
     End If
     End If
  Next i
  b = .Range("C" & Rows.Count).End(xlUp).Row
  If b > 12 Then .Range("C13:R" & b).ClearContents
  If a Then .Range("C13").Resize(a, 16).Value = arr1
End With
End Sub

 

[zine]

Đây bạn xem.

Sub ketqua()
Dim arr, arr1
Dim a As Long, b As Long, c As Long, i As Long, j As Long, lr As Long, k As Long
Dim dk As String, dks As String, T, aT, aso()
With Sheets("du lieu")
     lr = .Range("C" & Rows.Count).End(xlUp).Row
     If lr < 5 Then MsgBox "khong co du lieu": Exit Sub
     arr = .Range("C5:R" & lr).Value
     ReDim arr1(1 To UBound(arr, 1), 1 To 16)
End With
With Sheet1
     T = Array(.Range("E7").Value, .Range("E8").Value, .Range("E9").Value, .Range("E10").Value)
     aT = Array(1, 2, 3, 4)
     If Len(.Range("e7").Value) = 0 Then MsgBox "chon muc 1": Exit Sub
     For i = LBound(T) To UBound(T)
         If T(i) <> Empty Then
            c = c + 1
            If dk = Empty Then
               dk = T(i)
            Else
               dk = dk & "#" & T(i)
            End If
           ReDim Preserve aso(1 To c)
           aso(c) = aT(i)
         End If
    Next i
    For i = 1 To UBound(arr, 1)
        dks = Empty
        For k = LBound(aso) To UBound(aso)
            If dks = Empty Then
               dks = arr(i, aso(k))
            Else
               dks = dks & "#" & arr(i, aso(k))
            End If
        Next k
     If Len(arr(i, 2)) > 0 Then
     If UCase(dk) = UCase(dks) Then
        a = a + 1
        For j = 1 To 16
            arr1(a, j) = arr(i, j)
        Next j
     End If
     End If
  Next i
  b = .Range("C" & Rows.Count).End(xlUp).Row
  If b > 12 Then .Range("C13:R" & b).ClearContents
  If a Then .Range("C13").Resize(a, 16).Value = arr1
End With
End Sub

Cảm ơn bạn nhé
Tuy nhiên, ở file yêu cầu, mình có một số tinh chỉnh (có nêu trong file yêu cầu), không biết bạn có sửa code giúp mình được không?
- Ở các ô lựa chọn (ô E7; E8;E9;E10): nếu để trống (không chọn): thì nó chỉ ra khoản mục gốc thôi, không phải liệt kê tất cả khoản mục. Ví dụ: ô E8 để trống, thì Khoản mục chỉ ra các khoản mục cấp 1. Lý do: do số lượng khoản mục rất dài (hơn 500 khoản mục) nên nếu để trống mà đưa ra hết, thì khó nhìn. Vì vậy, muốn nhìn từ tổng thể đến chi tiết
- Ở các ô lựa chọn (ô E7; E8;E9;E10): nếu chọn All, thì bảng kết quả sẽ ra tất cả các khoản mục được chọn.
- Về lựa chọn ở các ô chọn (ô E7; E8; E9; E10): cũng do số lượng khoản mục dài, nên có thể gắn được ô chọn hiển thị bắt theo điều kiện ô cấp mẹ được không. Ví dụ: khi chọn khoản mục ở ô E7 là "CHi phí kinh doanh", thì ô chọn E8 chỉ hiển thị các khoản mục gắn với "Chi phí kinh doanh" thôi (để co gọn số lượng khoản mục lại cho dễ nhìn, thay vì liệt kê full toàn bộ khoản mục chọn)
Thanks