Giúp em tìm lỗi vòng lặp bị lỗi Run time error 13 : Type mismatch

Liên hệ QC
A

AnhThu-1976

Thành viên tích cực
Tham gia
17/10/14
Bài viết
1,019
Được thích
163
Em đang tập thử code:
đề bài: dựa vào cột A của sheet Ma tìm những mã này ở sheet Data gán xuống sheet KetQua
Mã: 
Sub Loc()
    Dim Data, kQarr, i, j, k, lr, lr1, Tmp
    ReDim kQarr(1 To 65000, 1 To 3)
    With Sheets("Data")
        lr = .Range("A" & Rows.Count).End(3).Row
        Data = .Range("A1:C" & lr).Value
    End With
    With Sheets("Ma")
        lr1 = .Range("A" & Rows.Count).End(3).Row
        MsgBox lr1
        Tmp = .Range("A1:A" & lr1).Value
    End With
    For i = 1 To UBound(Data)
        For j = 1 To UBound(Tmp)
            If Data(i, 1) = Tmp(j, 1) Then
                k = k + 1
                kQarr(k, 1) = Data(i, 1)
                kQarr(k, 2) = Data(i, 2)
                kQarr(k, 3) = Data(i, 3)
            End If
        Next j
    Next i
    Sheets("KetQua").Range("B5:D5000").Clear
    Sheets("KetQua").Range("B5:D5").Resize(k).Value = kQarr
End Sub
Code trên vẫn chạy đúng nếu bên sheet Ma có nhiều hơn 1 mã và ít nhất có 1 mã có trong bộ mã của cột A sheet Data
* Code bị lỗi
Nếu bên sheet Ma chỉ có 1 mã hoặc không có mã nào hoặc có nhiều hơn 1 mã nhưng nếu 1 trong các mã này không có trong bộ mã của cột A sheet Data thì đều bị báo lỗi
Các anh/chị giúp em phân tích và sửa lỗi code. Em cảm ơn
* điều chỉnh thêm: Em đã tìm thêm trường hợp không có kết quả thì xét If k>0 ....
 

File đính kèm

  • LayDanhSachNhieuDK.xlsm
    18 KB · Đọc: 16
Sắp xếp theo thời gian sắp xếp theo bầu chọn
AnhThu-1976 đã viết:
Em đang tập thử code:
đề bài: dựa vào cột A của sheet Ma tìm những mã này ở sheet Data gán xuống sheet KetQua
Mã: 
Sub Loc()
    Dim Data, kQarr, i, j, k, lr, lr1, Tmp
    ReDim kQarr(1 To 65000, 1 To 3)
    With Sheets("Data")
        lr = .Range("A" & Rows.Count).End(3).Row
        Data = .Range("A1:C" & lr).Value
    End With
    With Sheets("Ma")
        lr1 = .Range("A" & Rows.Count).End(3).Row
        MsgBox lr1
        Tmp = .Range("A1:A" & lr1).Value
    End With
    For i = 1 To UBound(Data)
        For j = 1 To UBound(Tmp)
            If Data(i, 1) = Tmp(j, 1) Then
                k = k + 1
                kQarr(k, 1) = Data(i, 1)
                kQarr(k, 2) = Data(i, 2)
                kQarr(k, 3) = Data(i, 3)
            End If
        Next j
    Next i
    Sheets("KetQua").Range("B5:D5000").Clear
    Sheets("KetQua").Range("B5:D5").Resize(k).Value = kQarr
End Sub
Code trên vẫn chạy đúng nếu bên sheet Ma có nhiều hơn 1 mã và ít nhất có 1 mã có trong bộ mã của cột A sheet Data
* Code bị lỗi
Nếu bên sheet Ma chỉ có 1 mã hoặc không có mã nào hoặc có nhiều hơn 1 mã nhưng nếu 1 trong các mã này không có trong bộ mã của cột A sheet Data thì đều bị báo lỗi
Các anh/chị giúp em phân tích và sửa lỗi code. Em cảm ơn
* điều chỉnh thêm: Em đã tìm thêm trường hợp không có kết quả thì xét If k>0 ....
Nhấp chuột vào đây để mở rộng...
Bạn giải thích rõ hơn chổ trùng mã ở sheet data, cụ thể trùng mã 123 nhưng 2 cột B và C khác nhau thì có lấy hay không? hoặc trùng mã 123 nhưng 2 cột B và C giống nhau thì có lấy hay không?
 
Upvote 0
VetMini đã viết:
Giải thích nhiều quá mà lại thiếu phần quan trọng nhất:
Báo lỗi ở câu nào?
Nhấp chuột vào đây để mở rộng...
Bây giờ tại sheet Mã đang có 2 mã 123 và 654 ,nếu ta bỏ bớt mã 654 chỉ còn mã 123 thôi thì khi chạy code nó báo lỗi dòng
For j = 1 To UBound(Tmp)
giaiphap đã viết:
Bạn giải thích rõ hơn chổ trùng mã ở sheet data, cụ thể trùng mã 123 nhưng 2 cột B và C khác nhau thì có lấy hay không? hoặc trùng mã 123 nhưng 2 cột B và C giống nhau thì có lấy hay không?
Nhấp chuột vào đây để mở rộng...
Trùng mã vẫn lấy bình thường, ví dụ mã 123 có 2 lần vẫn lấy 2 lần cho dù cột B hay C giống hay khác nhau
 
Upvote 0
- Nếu sheet Ma chỉ có 1 mã, biến tmp nhận 1 giá trị đơn chứ không phải mảng, do đó UBound, truy xuất tmp(i, j) đều bị lỗi
- Nếu k = 0 thì Redim lỗi kích thước không thể bằng không
 
Upvote 0
AnhThu-1976 đã viết:
Bây giờ tại sheet Mã đang có 2 mã 123 và 654 ,nếu ta bỏ bớt mã 654 chỉ còn mã 123 thôi thì khi chạy code nó báo lỗi dòng
For j = 1 To UBound(Tmp)

Trùng mã vẫn lấy bình thường, ví dụ mã 123 có 2 lần vẫn lấy 2 lần cho dù cột B hay C giống hay khác nhau
Nhấp chuột vào đây để mở rộng...
Bạn kiểm tra xem Tmp có phải mảng không trước khi dùng UBound(Tmp) bằng câu lệnh.
Mã: 
If IsArray(Tmp) Then
Bạn tùy biến mà sửa lại code cho đúng là được.
Còn thiếu mã thì bạn khai báo thêm biến như sau:
Mã: 
Dim kt As Boolean
Sau đó bạn sửa lại 2 vòng For như sau:
Mã: 
For j = 1 To UBound(Tmp)
            kt = True
            For i = 1 To UBound(Data)
                If Data(i, 1) = Tmp(j, 1) Then
                    k = k + 1
                    kQarr(k, 1) = Data(i, 1)
                    kQarr(k, 2) = Data(i, 2)
                    kQarr(k, 3) = Data(i, 3)
                    kt = False
                End If
            Next i
            If kt Then
                    k = k + 1
                    kQarr(k, 1) = Tmp(j, 1)
                End If
    Next j
 
Upvote 0
Dựa vào các trả lời trên, em viết như sau, không biết là code có thể rút gọn hơn không bắt đầu từ phần For ...
Mã: 
Sub Loc()
    Dim Data, kQarr, i, j, k, lr, lr1, Tmp
    ReDim kQarr(1 To 65000, 1 To 3)
    With Sheets("Data")
        lr = .Range("A" & Rows.Count).End(3).Row
        Data = .Range("A1:C" & lr).Value
    End With
    With Sheets("Ma")
        lr1 = .Range("A" & Rows.Count).End(3).Row
        MsgBox lr1
        Tmp = .Range("A1:A" & lr1).Value
    End With
    For i = 1 To UBound(Data)
        If IsArray(Tmp) Then
            For j = 1 To UBound(Tmp)
                If Data(i, 1) = Tmp(j, 1) Then
                    k = k + 1
                    kQarr(k, 1) = Data(i, 1)
                    kQarr(k, 2) = Data(i, 2)
                    kQarr(k, 3) = Data(i, 3)
                End If
            Next j
        End If
        If Data(i, 1) = Sheets("Ma").Range("A1") Then
            k = k + 1
            kQarr(k, 1) = Data(i, 1)
            kQarr(k, 2) = Data(i, 2)
            kQarr(k, 3) = Data(i, 3)
        End If
    Next i
    Sheets("KetQua").Range("B5:D5000").Clear
    If k > 0 Then
        Sheets("KetQua").Range("B5:D5").Resize(k).Value = kQarr
    End If
End Sub
Em cảm ơn các anh đã hướng dẫn
 
Upvote 0
AnhThu-1976 đã viết:
Tmp
Nhấp chuột vào đây để mở rộng...
Không ai làm vậy cả. Kiểm tra thì kiểm tra ngay khi nó xuất hiện, nhét vào lòng lặp để mắc khổ.

Kỹ thuật xử lý chép Range vào Array mình hướng dẫn nhiều rồi cơ mà.
Đơn giản nhất là +1 và -1 vào biến lR1
PHP: 
lR1 = .Range("A" & Rows.Count).End(3).Row + 1
Tmp = .Range("A1:A" & lR1).Value2
lR1 = Ubound(Tmp,1) -1
'...
For j = 1 To lR1 'Đừng tính đi tính lại cái UBound(Tmp) trong vòng lặp cho khổ cuộc đời
 
Upvote 0
If IsArray(Tmp) Then
Câu này phải để ra ngoài vòng lặp, vì nếu là mảng mới lặp, không phải mảng mà lặp thì lại lỗi UBound nữa.
Còn nếu Else thì sao? vẫn phải chạy cái gì đó chứ?
Bạn sửa theo ý IsArray, còn nếu là tôi thì sẽ xét ngay lr1 và If ngay trên lr1.
 
Upvote 0
AnhThu-1976 đã viết:
Em đang tập thử code:
đề bài: dựa vào cột A của sheet Ma tìm những mã này ở sheet Data gán xuống sheet KetQua
Mã: 
Sub Loc()
    Dim Data, kQarr, i, j, k, lr, lr1, Tmp
    ReDim kQarr(1 To 65000, 1 To 3)
    With Sheets("Data")
        lr = .Range("A" & Rows.Count).End(3).Row
        Data = .Range("A1:C" & lr).Value
    End With
    With Sheets("Ma")
        lr1 = .Range("A" & Rows.Count).End(3).Row
        MsgBox lr1
        Tmp = .Range("A1:A" & lr1).Value
    End With
    For i = 1 To UBound(Data)
        For j = 1 To UBound(Tmp)
            If Data(i, 1) = Tmp(j, 1) Then
                k = k + 1
                kQarr(k, 1) = Data(i, 1)
                kQarr(k, 2) = Data(i, 2)
                kQarr(k, 3) = Data(i, 3)
            End If
        Next j
    Next i
    Sheets("KetQua").Range("B5:D5000").Clear
    Sheets("KetQua").Range("B5:D5").Resize(k).Value = kQarr
End Sub
Code trên vẫn chạy đúng nếu bên sheet Ma có nhiều hơn 1 mã và ít nhất có 1 mã có trong bộ mã của cột A sheet Data
* Code bị lỗi
Nếu bên sheet Ma chỉ có 1 mã hoặc không có mã nào hoặc có nhiều hơn 1 mã nhưng nếu 1 trong các mã này không có trong bộ mã của cột A sheet Data thì đều bị báo lỗi
Các anh/chị giúp em phân tích và sửa lỗi code. Em cảm ơn
* điều chỉnh thêm: Em đã tìm thêm trường hợp không có kết quả thì xét If k>0 ....
Nhấp chuột vào đây để mở rộng...
Nếu mà là mình thì mình viết a1:b là được.Nhưng có 1 cái là nó sẽ làm cho mảng đó nặng hơn.Nhưng chắc cũng không sao.
 
Upvote 0
befaint đã viết:
Không ai làm vậy cả. Kiểm tra thì kiểm tra ngay khi nó xuất hiện, nhét vào lòng lặp để mắc khổ.

Kỹ thuật xử lý chép Range vào Array mình hướng dẫn nhiều rồi cơ mà.
Đơn giản nhất là +1 và -1 vào biến lR1
PHP: 
lR1 = .Range("A" & Rows.Count).End(3).Row + 1
Tmp = .Range("A1:A" & lR1).Value2
lR1 = Ubound(Tmp,1) -1
'...
For j = 1 To lR1 'Đừng tính đi tính lại cái UBound(Tmp) trong vòng lặp cho khổ cuộc đời
Nhấp chuột vào đây để mở rộng...
Mình sửa lại như sau
Mã: 
Sub Loc()
    Dim Data, kQarr, i, j, k, lr, lr1, Tmp
    ReDim kQarr(1 To 65000, 1 To 3)
    With Sheets("Data")
        lr = .Range("A" & Rows.Count).End(3).Row
        Data = .Range("A1:C" & lr).Value
    End With
    With Sheets("Ma")
        lr1 = .Range("A" & Rows.Count).End(3).Row + 1' cộng 1 vào chỗ này
        MsgBox lr1
        Tmp = .Range("A1:A" & lr1).Value
    End With
    For i = 1 To UBound(Data)
        For j = 1 To UBound(Tmp) - 1' trừ 1 vào chỗ này
            If Data(i, 1) = Tmp(j, 1) Then
                k = k + 1
                kQarr(k, 1) = Data(i, 1)
                kQarr(k, 2) = Data(i, 2)
                kQarr(k, 3) = Data(i, 3)
            End If
        Next j
    Next i
    Sheets("KetQua").Range("B5:D5000").Clear
    If k > 0 Then
        Sheets("KetQua").Range("B5:D5").Resize(k).Value = kQarr
    End If
End Sub
 
Upvote 0
befaint đã viết:
Thua!
Nhấp chuột vào đây để mở rộng...
Tôi thì thua sì tin code GPE lâu rồi.
Một mảng dữ liệu đàng hoàng đọc từ bảng tính ra và dùng để so sánh mà đặt cho cái tên Tmp.
Nếu bảo tạm thời thì biến nào trong chương trình lại chẳng tạm thời.
Cái biến thực sự là tạm thời (dùng tạm và dùng lại được) thì chẳng chịu dùng.

Trên tính cách thì Tmp nó xứng đáng cho lr và lr1 hơn.
 
Upvote 0
AnhThu-1976 đã viết:
Vậy nhờ bạn bạn viết thẳng vô code, cảm ơn bạn!
Nhấp chuột vào đây để mở rộng...
Befaint mất kiên nhẫn với bạn rồi. Mà cũng phải thôi, bạn ấy nói 2 chuyện mà bạn chẳng làm theo chuyện nào:
- End row + 1 sau đó tính UBound rồi -1
- Đừng tính UBound trên vòng lặp
Tiếp theo là bạn cũng mất kiên nhẫn và không muốn tự làm nữa.

Nếu bạn thích thì bạn làm cả tôi mất kiên nhẫn bằng cách đọc bài 9 và thử làm theo
 
Upvote 0
@AnhThu-1976
Hình như ý bài 8 là bên dưới đây thì phải
Mã: 
Sub Loc_()
    Dim Data, kQarr, i, j, k, lr, lr1, Tmp
    ReDim kQarr(1 To 65000, 1 To 3)
    With Sheets("Data")
        lr = .Range("A" & Rows.Count).End(3).Row
        Data = .Range("A1:C" & lr).Value
    End With
    With Sheets("Ma")
        lr1 = .Range("A" & Rows.Count).End(3).Row + 1 ' cô?ng 1 va`o chô~ na`y
        MsgBox lr1
        Tmp = .Range("A1:A" & lr1).Value
        lr1 = UBound(Tmp) - 1'Hình như là trừ 1 ở đây
    End With
    For i = 1 To UBound(Data)
        For j = 1 To lr1'Hình như là dùng luôn lr1 ở đây
            If Data(i, 1) = Tmp(j, 1) Then
                k = k + 1
                kQarr(k, 1) = Data(i, 1)
                kQarr(k, 2) = Data(i, 2)
                kQarr(k, 3) = Data(i, 3)
            End If
        Next j
    Next i
    Sheets("KetQua").Range("B5:D5000").Clear
    If k > 0 Then
        Sheets("KetQua").Range("B5:D5").Resize(k).Value = kQarr
    End If
End Sub
 
Upvote 0
CHAOQUAY đã viết:
@AnhThu-1976
Hình như ý bài 8 là bên dưới đây thì phải
Mã: 
Sub Loc_()
    Dim Data, kQarr, i, j, k, lr, lr1, Tmp
    ReDim kQarr(1 To 65000, 1 To 3)
    With Sheets("Data")
        lr = .Range("A" & Rows.Count).End(3).Row
        Data = .Range("A1:C" & lr).Value
    End With
    With Sheets("Ma")
        lr1 = .Range("A" & Rows.Count).End(3).Row + 1 ' cô?ng 1 va`o chô~ na`y
        MsgBox lr1
        Tmp = .Range("A1:A" & lr1).Value
        lr1 = UBound(Tmp) - 1'Hình như là trừ 1 ở đây
    End With
    For i = 1 To UBound(Data)
        For j = 1 To lr1'Hình như là dùng luôn lr1 ở đây
            If Data(i, 1) = Tmp(j, 1) Then
                k = k + 1
                kQarr(k, 1) = Data(i, 1)
                kQarr(k, 2) = Data(i, 2)
                kQarr(k, 3) = Data(i, 3)
            End If
        Next j
    Next i
    Sheets("KetQua").Range("B5:D5000").Clear
    If k > 0 Then
        Sheets("KetQua").Range("B5:D5").Resize(k).Value = kQarr
    End If
End Sub
Nhấp chuột vào đây để mở rộng...
Nếu lr = Rows.Count: Tiêu tùng
For i = 1 To UBound(Data) vẫn còn tính UBound(Data) rất nhiều lần
If Data(i, 1) = Tmp(j, 1) Then: Data(i, 1) phải lấy nhiều lần

For i = 1 To UBound(Data)
For j = 1 To lr1'Hình như là dùng luôn lr1 ở đây
.....
Next j
Next i
Chạy chậm do phải duyệt hết i, j. Cần có Exit For của For j
 
Upvote 0
HieuCD đã viết:
Nếu lr = Rows.Count: Tiêu tùng
For i = 1 To UBound(Data) vẫn còn tính UBound(Data) rất nhiều lần

For i = 1 To UBound(Data)
For j = 1 To lr1'Hình như là dùng luôn lr1 ở đây
.....
Next j
Next i
Chạy chậm do phải duyệt hết i, j. Cần có Exit For của For j
Nhấp chuột vào đây để mở rộng...
Bài trên chỉ muốn giải thích góp ý của bài 8 thôi bác. Với lại hình như là thớt cũng chỉ chạy thử code nên sửa như bài 8 xong, thấy chạy là dừng, không làm gì nữa bác ạ.
 
Upvote 0
HieuCD đã viết:
Đã làm thì nên làm tới bến sáng về sớm. Khà khà:):)
Nhấp chuột vào đây để mở rộng...
Thớt học code theo kiểu Cô Tô Mộ Dung gom tất cả chiêu thức thiên hạ về thư viện mình mà luyện.
Đã nhiều lần tôi cảnh báo rằng Kiều Phong chỉ cần Hàng Long Thập Bát Chưởng vũ lộng Tụ Hiền Trang. Cái quan trọng là bản chất nội lực, một tiếng quát đủ đe doạ Đoàn Diên Khánh không dám dở trò phúc ngữ.

(*) tôi nói theo ý của chính truyện Kim Dung, không phải phiên bản phim Hồng Kông đã chỉnh sửa nhân vật Mộ Dung Phục để câu nước mắt khán giả.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

TrinhThiHai_Kt
  • Dán lên cao
Các câu hỏi về sử dụng diễn đàn
5 6 7
Trả lời
122
Đọc
185K
huongxuan10
H
H
Tắt Com Add-ins
Trả lời
1
Đọc
2
befaint
befaint
H
Trích Lọc dữ liệu với Macro
Trả lời
19
Đọc
1K
huhumalu
H
H
Giúp em đặt thêm công thức cho phép năm
    • Chấp nhận
Trả lời
1
Đọc
37
Phan Thế Hiệp
Phan Thế Hiệp
8
  • Question
Xin giúp: Nhóm (group data) các dòng trong bảng tính
Trả lời
7
Đọc
291
843824
8
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom