Lộc dữ liệu theo điều kiện

[lhthai]

Hiện tại mình có đoạn code nhập giá trị vào cột D2 thì lộc dữ liệu qua sheet3
Nhưng nếu mình gõ dữ liệu 141020 thì thông báo lỗi còn gõ 150126 thì ra kết quả bình thường

Private Sub CommandButton21_Click()
Dim Arr(), DArr(), I As Long, J As Long, K, DK
    Arr = Range([A4], [A65000].End(xlUp)).Resize(, 7).Value
ReDim DArr(1 To UBound(Arr, 1), 1 To 7)
    DK = Range("D2").Value
    For I = 1 To UBound(Arr, 1)
        If Arr(I, 4) = DK And Arr(I, 5) = "A" Then
            K = K + 1
            DArr(K, 1) = Arr(I, 1)
            DArr(K, 2) = Arr(I, 2)
            DArr(K, 3) = Arr(I, 3)
            DArr(K, 4) = Arr(I, 4)
            DArr(K, 5) = Arr(I, 5)
            DArr(K, 6) = Arr(I, 6)
            DArr(K, 7) = Arr(I, 7)
            End If
    Next
    Sheet3.[A4:G65536].ClearContents
    Sheet3.[A4].Resize(K, 7) = DArr
End Sub

 

[Ba Tê]

Hiện tại mình có đoạn code nhập giá trị vào cột D2 thì lộc dữ liệu qua sheet3
Nhưng nếu mình gõ dữ liệu 141020 thì thông báo lỗi còn gõ 150126 thì ra kết quả bình thường

Private Sub CommandButton21_Click()
Dim Arr(), DArr(), I As Long, J As Long, K, DK
    Arr = Range([A4], [A65000].End(xlUp)).Resize(, 7).Value
ReDim DArr(1 To UBound(Arr, 1), 1 To 7)
    DK = Range("D2").Value
    For I = 1 To UBound(Arr, 1)
        If Arr(I, 4) = DK And Arr(I, 5) = "A" Then
            K = K + 1
            DArr(K, 1) = Arr(I, 1)
            DArr(K, 2) = Arr(I, 2)
            DArr(K, 3) = Arr(I, 3)
            DArr(K, 4) = Arr(I, 4)
            DArr(K, 5) = Arr(I, 5)
            DArr(K, 6) = Arr(I, 6)
            DArr(K, 7) = Arr(I, 7)
            End If
    Next
    Sheet3.[A4:G65536].ClearContents
    Sheet3.[A4].Resize(K, 7) = DArr
End Sub

1/ Dữ liệu trong sheet2 của bạn là 8 cột chứ không phải 7
2/

If Arr(I, 4) = DK And Arr(I, 5) = "A" Then '-------->Lỗi'

Cột 5 trong mảng Arr là cột trống, dữ liệu chứa "A" là cột 6
3/

Sheet3.[A4].Resize(K, 8) = dArr '------------>'Lỗi

Tìm không thấy dữ liệu phù hợp để nạp vào dArr(), nên K=0.
4/ Bạn khai báo biến J nhưng không xài.
Nếu tôi đoán đúng thì code như vầy:

Private Sub CommandButton1_Click()
Dim Arr(), dArr(), I As Long, J As Long, K As Long, DK
Arr = Range([A4], [A65000].End(xlUp)).Resize(, 8).Value
ReDim dArr(1 To UBound(Arr, 1), 1 To 8)
DK = Range("D2").Value
For I = 1 To UBound(Arr, 1)
    If Arr(I, 4) = DK And Arr(I, 6) = "A" Then
        K = K + 1
        For J = 1 To 8
            dArr(K, J) = Arr(I, J)
        Next J
    End If
Next I
Sheet3.[A4:H65536].ClearContents
If K Then Sheet3.[A4].Resize(K, 8) = dArr
End Sub

 

[lhthai]

1/ Dữ liệu trong sheet2 của bạn là 8 cột chứ không phải 7
2/

If Arr(I, 4) = DK And Arr(I, 5) = "A" Then '-------->Lỗi'

Cột 5 trong mảng Arr là cột trống, dữ liệu chứa "A" là cột 6
3/

Sheet3.[A4].Resize(K, 8) = dArr '------------>'Lỗi

Tìm không thấy dữ liệu phù hợp để nạp vào dArr(), nên K=0.
4/ Bạn khai báo biến J nhưng không xài.
Nếu tôi đoán đúng thì code như vầy:

Private Sub CommandButton1_Click()
Dim Arr(), dArr(), I As Long, J As Long, K As Long, DK
Arr = Range([A4], [A65000].End(xlUp)).Resize(, 8).Value
ReDim dArr(1 To UBound(Arr, 1), 1 To 8)
DK = Range("D2").Value
For I = 1 To UBound(Arr, 1)
    If Arr(I, 4) = DK And Arr(I, 6) = "A" Then
        K = K + 1
        For J = 1 To 8
            dArr(K, J) = Arr(I, J)
        Next J
    End If
Next I
Sheet3.[A4:H65536].ClearContents
If K Then Sheet3.[A4].Resize(K, 8) = dArr
End Sub

Cám ơn Anh nhiều nha