Code lọc dữ liệu cho nút Combo

[NH_DK]

A/C viết dùm em code lọc dữ liệu cho nút Combo này nhé! Câu hỏi cụ thể trong file đính kèm.

 

[NH_DK]

Em viết code này sao nó vẫn không chạy được:

Private Sub ComboBox1_Change()
 With Range([A12], [A10000].End(xlUp))
    .Offset(, 0).Value = "=IF(DATA!RC=SOCT!R1C5,DATA!RC[1],"""")"
    .Offset(, 1).Value = "=IF(DATA!RC[-2]=SOCT!R1C5,DATA!RC[1],"""")"
    .Offset(, 2).Value = "=IF(DATA!RC[-3]=SOCT!R1C5,DATA!RC[1],"""")"
    .Offset(, 3).Value = "=IF(DATA!RC[-4]=SOCT!R1C5,DATA!RC[1],"""")"
    .Offset(, 4).Value = "=IF(DATA!RC[-5]=SOCT!R1C5,DATA!RC[1],"""")"
    .Offset(, 5).Value = "=IF(DATA!RC[-6]=SOCT!R1C5,DATA!RC[1],"""")"
    .Offset(, 6).Value = "=IF(DATA!RC[-7]=SOCT!R1C5,DATA!RC[1],"""")"
    .Offset(, 7).Value = "=IF(DATA!RC[-8]=SOCT!R1C5,DATA!RC[1],"""")"
    .Offset(, 8).Value = "=IF(DATA!RC[-9]=SOCT!R1C5,DATA!RC[1],"""")"
    .Offset(, 9).Value = "=IF(DATA!RC[-10]=SOCT!R1C5,DATA!RC[1],"""")"
    .Offset(, 10).Value = "=IF(DATA!RC[-11]=SOCT!R1C5,DATA!RC[1],"""")"
    .Offset(, 11).Value = "=IF(DATA!RC[-12]=SOCT!R1C5,DATA!RC[1],"""")"
 With .Offset(, 0).Resize(, 12): .Value = .Value: End With
    Dim eRw As Long, jJ As Byte:          Dim WF, Cls As Range
        eRw = [B1000].End(xlUp).Row
        Application.ScreenUpdating = False
    Set WF = Application.WorksheetFunction
    For Each Cls In [C12].Resize(eRw)
        If WF.CountIf(Cls.Resize(, 4), "<>0") = 0 Then
            Cls.EntireRow.Hidden = True
        End If
    Next Cls
 End With
End Sub

A/C xem và sửa dùm em nhé!!

 

[ThuNghi]

A/C viết dùm em code lọc dữ liệu cho nút Combo này nhé! Câu hỏi cụ thể trong file đính kèm.

File ví dụ đưa lên nên bỏ bớt những phần link, chỉ đưa sát yêu cầu, file khá lớn nên làm biếng.
Bạn dùng code sau, thay vì dùng AdFi với E1 tôi dùng Array.

Sub TimMa()
Dim endR As Long, i As Long, s As Long, k As Long
Dim Arr(), ArrKQ(1 To 1000, 1 To 12)
Dim SLnhap, SLxuat, STnhap, STxuat
Dim MaHH As String
With Sheets("Data")
  endR = .Cells(65000, 1).End(xlUp).Row
  Arr = .Range("A12:M" & endR).Value
End With
With Sheets("SoCT")
  MaHH = .[E1]
End With
s = 0
For i = 1 To UBound(Arr)
  If Arr(i, 1) = MaHH Then
    s = s + 1
    For k = 1 To 10
      ArrKQ(s, k) = Arr(i, k + 1)
    Next k
    SLnhap = SLnhap + ArrKQ(s, 7)
    SLxuat = SLxuat + ArrKQ(s, 9)
    STnhap = STnhap + ArrKQ(s, 8)
    STxuat = STxuat + ArrKQ(s, 10)
    ArrKQ(s, 11) = Sheets("SoCT").Range("K11") + SLnhap - SLxuat
    ArrKQ(s, 12) = Sheets("SoCT").Range("L11") + STnhap - STxuat
  End If
Next i
If s = 0 Then Exit Sub
With Sheets("SoCT")
  endR = .Cells(65000, 1).End(xlUp).Row + 2
  With .Range("A" & endR)
    .Resize(s, 12) = ArrKQ
  End With
End With
Erase Arr(), ArrKQ
End Sub

Bạn có thể dùng Worksheet_Change để chạy code.

 

[NH_DK]

File ví dụ đưa lên nên bỏ bớt những phần link, chỉ đưa sát yêu cầu, file khá lớn nên làm biếng.
Bạn dùng code sau, thay vì dùng AdFi với E1 tôi dùng Array.

Sub TimMa()
Dim endR As Long, i As Long, s As Long, k As Long
Dim Arr(), ArrKQ(1 To 1000, 1 To 12)
Dim SLnhap, SLxuat, STnhap, STxuat
Dim MaHH As String
With Sheets("Data")
endR = .Cells(65000, 1).End(xlUp).Row
Arr = .Range("A12:M" & endR).Value
End With
With Sheets("SoCT")
MaHH = .[E1]
End With
s = 0
For i = 1 To UBound(Arr)
If Arr(i, 1) = MaHH Then
s = s + 1
For k = 1 To 10
ArrKQ(s, k) = Arr(i, k + 1)
Next k
SLnhap = SLnhap + ArrKQ(s, 7)
SLxuat = SLxuat + ArrKQ(s, 9)
STnhap = STnhap + ArrKQ(s, 8)
STxuat = STxuat + ArrKQ(s, 10)
ArrKQ(s, 11) = Sheets("SoCT").Range("K11") + SLnhap - SLxuat
ArrKQ(s, 12) = Sheets("SoCT").Range("L11") + STnhap - STxuat
End If
Next i
If s = 0 Then Exit Sub
With Sheets("SoCT")
endR = .Cells(65000, 1).End(xlUp).Row + 2
With .Range("A" & endR)
.Resize(s, 12) = ArrKQ
End With
End With
Erase Arr(), ArrKQ
End Sub

Bạn có thể dùng Worksheet_Change để chạy code.

Anh ơi, em làm theo cách của anh rồi nhưng vẫn không được. Nó cập nhật lôn xộn lắm. Anh kiểm tra lại dùm em nhé!

 

[ThuNghi]

Anh ơi, em làm theo cách của anh rồi nhưng vẫn không được. Nó cập nhật lôn xộn lắm. Anh kiểm tra lại dùm em nhé!

Lộn xộn thế nào, xin cho cụ thể "lộn xộn".
Bạn chọn mã ở comboBox, giá trị gán ở E1. Bạn nhấn Atr F8 run code TimMa thử xem.
File đính kèm OK mà.

 

[sealand]

Bạn chép code sau thế vào Code của bạn nha
Nếu dữ liệu lớn thêm dòng sau vào đầu Code

Application.ScreenUpdating = False

Private Sub ComboBox1_Change()
Dim Cll1, Cll2 As Range, d1
Set Cll1 = Sheet2.[a12]
Set Cll2 = Sheet3.[a12]
d1 = Sheet3.[a65536].End(xlUp).Row
Sheet3.Range("a12:L" & IIf(d1 > 11, d1, 11)).ClearContents
Do While Trim(Cll1) <> ""
If Cll1 = Me.ComboBox1 Then
Cll2.Resize(, 10).Value = Cll1.Offset(, 1).Resize(, 10).Value
Cll2.Offset(, 10) = Cll2.Offset(-1, 10) + Cll2.Offset(, 6) - Cll2.Offset(, 8)
Cll2.Offset(, 11) = Cll2.Offset(-1, 11) + Cll2.Offset(, 7) - Cll2.Offset(, 9)
Set Cll2 = Cll2.Offset(1)
End If
Set Cll1 = Cll1.Offset(1)
Loop
End Sub