Giúp xem code vba lấy giá trị không trùng

[Tuan_hcth]

Em chào anh, chị
Em đang viết code lấy các giá trị trong mảng arr() không tồn tại trong mảng tarr() để gán vào mảng karr() nhưng thông báo lỗi như sau:

Em nhờ các anh, chị xem giúp ạ. Em cảm ơn

 

[PacificPR]

Em chào anh, chị
Em đang viết code lấy các giá trị trong mảng arr() không tồn tại trong mảng tarr() để gán vào mảng karr() nhưng thông báo lỗi như sau:
View attachment 233614
Em nhờ các anh, chị xem giúp ạ. Em cảm ơn

Bạn thử dí vào chữ k đó xem nó bằng bao nhiêu rồi

 

[Tuan_hcth]

Bạn thử dí vào chữ k đó xem nó bằng bao nhiêu rồi

1001 anh ạ. Phải sửa thế nào ạ

 

[PacificPR]

Bạn thử Redim karr(1 to Ubound(arr), 1 to 1) xem sao

 

[Tuan_hcth]

Bạn thử Redim karr(1 to Ubound(arr), 1 to 1) xem sao

Em đã thử rồi nhưng không được ạ

 

[linhthuydanhbo89]

bạn gửi file lên mọi người xem

 

[snow25]

Em đã thử rồi nhưng không được ạ

Bạn sửa thành

Redim karr(1 to Ubound(arr) * ubound(tarr), 1 to 1)

 

[PacificPR]

Em đã thử rồi nhưng không được ạ

Nhìn ảnh không kỹ. Nó còn cái vòng lặp của tarr nữa.
Bài này dùng Dic gì gì đó chắc nhẹ nhàng hơn nhiều

 

[Tuan_hcth]

Bạn sửa thành

Redim karr(1 to Ubound(arr) * ubound(tarr), 1 to 1)

Bạn sửa thành

Redim karr(1 to Ubound(arr) * ubound(tarr), 1 to 1)

Không báo lỗi nhưng kết quả không chính xác, những giá trị trung nó cũng liệt kê và nhân thành nhiều lần.

 

[Nhất Chi Lan]

Bạn cho xin cái file mình tham khảo thử với

 

[snow25]

Không báo lỗi nhưng kết quả không chính xác, những giá trị trung nó cũng liệt kê và nhân thành nhiều lần.

Đấy là code của bạn mà.Có phải mình viết đâu.Dữ liệu mình cũng có nhìn thấy nó thế nào đâu.Mà cũng chẳng biết bạn viết cái gì nữa.Bạn chỉ đưa mỗi cái file ảnh code.Sửa còn không được à.Tốt nhất bạn đưa cái file lên nhé...

 

[Nhất Chi Lan]

Người đâu mà keo vậy. Xin có cái File thôi mà cũng không cho

Sub Ma_DNR()
    Dim Dic As Object, Arr, dArr(), tArr()
    Dim Er1 As Long, Er2 As Long, I As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
    Er1 = .Range("E" & Rows.Count).End(xlUp).Row
    Arr = .Range("A5:I" & Er1).Value
End With
With Sheet2
    Er2 = .Range("B" & Rows.Count).End(xlUp).Row
    tArr = .Range("B3:G" & Er2).Value
End With
If Er1 >= 5 And Er2 >= 3 Then
    For I = 1 To UBound(tArr)
        Dic.Item(tArr(I, 1)) = I
    Next I
    ReDim dArr(1 To UBound(Arr), 1 To 1)
    For I = 1 To UBound(Arr)
        If Not Dic.Exists(Arr(I, 5)) Then
            K = K + 1
            dArr(K, 1) = Arr(I, 5)
        End If
    Next I
    With Sheet4
        If K Then
            .Range("B" & Er2 + 1, .Range("B" & Rows.Count).End(xlUp)).ClearContents
            .Range("B" & Er2 + 1).Resize(K) = dArr
        Else
            GoTo Thoat:
        End If
    End With
Else
Thoat:
    Beep
End If
Set Dic = Nothing
End Sub

 

[Tuan_hcth]

Người đâu mà keo vậy. Xin có cái File thôi mà cũng không cho

Sub Ma_DNR()
    Dim Dic As Object, Arr, dArr(), tArr()
    Dim Er1 As Long, Er2 As Long, I As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
    Er1 = .Range("E" & Rows.Count).End(xlUp).Row
    Arr = .Range("A5:I" & Er1).Value
End With
With Sheet2
    Er2 = .Range("B" & Rows.Count).End(xlUp).Row
    tArr = .Range("B3:G" & Er2).Value
End With
If Er1 >= 5 And Er2 >= 3 Then
    For I = 1 To UBound(tArr)
        Dic.Item(tArr(I, 1)) = I
    Next I
    ReDim dArr(1 To UBound(Arr), 1 To 1)
    For I = 1 To UBound(Arr)
        If Not Dic.Exists(Arr(I, 5)) Then
            K = K + 1
            dArr(K, 1) = Arr(I, 5)
        End If
    Next I
    With Sheet4
        If K Then
            .Range("B" & Er2 + 1, .Range("B" & Rows.Count).End(xlUp)).ClearContents
            .Range("B" & Er2 + 1).Resize(K) = dArr
        Else
            GoTo Thoat:
        End If
    End With
Else
Thoat:
    Beep
End If
Set Dic = Nothing
End Sub

Em cảm ơn anh nhiều ạ

 

[Nhất Chi Lan]

Em cảm ơn anh nhiều ạ

Giận rồi. Không chơi nữa