Lỗi Run-time error '9' VBA. Nhờ cao nhân fix giùm!!!!

[princewind31]

Mình có đoạn code so sánh 2 bảng dữ liệu nhưng đang bị lỗi.
Nhờ anh em fix hộ

 

[Maika8008]

Mình có đoạn code so sánh 2 bảng dữ liệu nhưng đang bị lỗi.
Nhờ anh em fix hộ

Fix: k = 0 nên Redim KQ(1 To k, 1 To UBound(tmp, 2)) lỗi out of range. Còn tại sao k = 0 thì rà lại code. Muốn không báo lỗi thì đặt điều kiện If k > 0 trước đó và lúc đó kết quả sẽ empty

 

[VetMini]

Fix: k = 0 nên Redim KQ(1 To k, 1 To UBound(tmp, 2)) lỗi out of range. Còn tại sao k = 0 thì rà lại code. Muốn không báo lỗi thì đặt điều kiện If k > 0 trước đó và lúc đó kết quả sẽ empty

k = 0 nên Redim KQ(1 To k, 1 To UBound(tmp, 2)) lỗi out of range --> debug
Muốn không báo lỗi thì đặt điều kiện If k > 0 trước đó và lúc đó kết quả sẽ empty --> fix/correct
Tiếng Tây nó rắc rối vậy đó
Vả lại, bảo 'nhờ fix' thì hơi xấc. Đáng lẽ phải nói 'nhờ chỉ cách fix'.

 

[princewind31]

Sorry các bạn nếu mình có những câu thích hợp.
Nhưng các bạn có thể giúp mình làm vd với

 

[huhumalu]

Sorry các bạn nếu mình có những câu thích hợp.
Nhưng các bạn có thể giúp mình làm vd với

Bạn có 2 vòng lặp kiểm tra. Nếu cái chk = 0 thì tăng k lên thành k +1.
Vậy nếu điều trên không xảy ra, tức là không có cái chk = 0 cả thì k vẫn bằng 0.
Thuật toán là của bạn chứ, làm sao mình biết bạn đang muốn gì khi kiểm tra điều kiện trên.

    If chk = 0 Then
        k = k + 1
        For c = 1 To 4
            tmp(k, c) = tmp1(r, c)
        Next c
    End If
      
    If chk = 0 Then
        k = k + 1
        For c = 1 To 3
            tmp(k, c) = tmp2(r, c)
        Next c
            tmp(k, 5) = tmp2(r, 4)
    End If

Đọc qua cái dữ liệu rồi đoán như vầy:
Dữ liệu Kitting và PPC khi so sánh nếu chỗ nào khác nhau thì đánh dấu vào cái đang tô xanh lá ?
Nếu vậy thì kích thước của cái bảng Kitting và PPC nó phải giống nhau mới đi so và kết quả trả về nó cũng có kích thước tương đương.
--> vậy chỉ cần 1 vòng lặp quét qua 2 bảng Kitting và PPC lần, cái nào khác thì đánh dấu vào bảng xanh lá.
-----------------
mà sao mình kg dùng cái Conditional Formatting, nó tô ra các ô khác nhau ?

 

[SA_DQ]

Nên thay hay bỏ hẵn câu lệnh On Error Resume Next đi thì hơn;

Function fRNG(Rng As Range) As Variant
If Rng.Columns.Count = 1 Then Exit Function
Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
Dim R As Long, Tmp(), DG(), KQ(), K As Long, So As Double, iR As Long
On Error GoTo LoiCT
 Tmp = Rng.Value
For R = 1 To UBound(Tmp, 1)
    If Tmp(R, 1) <> "" And Not Dic.Exists(Tmp(R, 1) & Tmp(R, 2)) Then
        Dic.Add Tmp(R, 1) & Tmp(R, 2), ""
    End If
Next R
 DG = Dic.keys
Set Dic = Nothing
 ReDim KQ(1 To UBound(DG) + 1, 1 To UBound(Tmp, 2))
For K = 1 To UBound(KQ, 1)
1    So = 0: iR = 0
    For R = 1 To UBound(Tmp, 1)
3        If Tmp(R, 1) & Tmp(R, 2) = DG(K - 1) Then So = So + Tmp(R, 4):
        iR = R:                     MsgBox iR
    Next R
5    For C = 1 To UBound(KQ, 2) - 1
        KQ(K, C) = Tmp(iR, C)
    Next C
        KQ(K, UBound(KQ, 2)) = So
19 Next K
fRNG = KQ
Err_:       Exit Function
LoiCT:
    If Err = 13 Then
        MsgBox Err, , Erl():                GoTo Err_
    Else
        Resume Next
    End If
End Function