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

Liên hệ QC

AnhThu-1976

Thành viên tích cực
Tham gia
17/10/14
Bài viết
1,016
Đượ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
AnhThu-1976

Phương hướng để giải quyết code của Bạn đơn giản là thế này:

1. Khi lấy Row Cuối cùng chứa dữ liệu bắt đầu từ một Range thì bạn vận dụng đoạn code sau:

PHP:
LR = WS.Range("A5")(Rows.Count  - WS.Range("A5").Row, 1).End(xlUp).Row - WS.Range("A5").Row + 1

Và Tạo mảng bằng phương thức Resize, Range("A5").Resize(LR, Col)


2. Kiểm soát nếu Mảng nhận được Từ phương thức End là Không đủ điều kiện

PHP:
If (WS.Range("A5").Value = vbNullString And LR = 1) Or LR < 1 Then Exit Sub

*Nếu là bạn đang học VBA thì học thêm khai báo Static
Đơn giản là gọi 10 lần Test_Static liên tục sẽ hiểu:

PHP:
Sub Test_Static()
   Static I As Long: I = I + 1
   Debug.Print I
   If I > 5 Then End 'Khởi tạo lại toàn bộ biến Toàn cục Và các khai báo kiểu Static, đồng thời dừng mọi tiến trình của Application'
   'If I > 5 Then I = 0'
End Sub

Static áp dụng cho bài trên: Bỏ qua các phần tử đã duyệt trước đó ở Sheet("Ma") chẳng hạn

*Bạn tham khảo đoạn code dưới đây để vận dụng
Nếu bạn biết ReDim Preserve thì vận dụng thêm



PHP:
Sub Loc()
  Dim WB As Workbook
  Set WB = ThisWorkbook
  '-----------------------------'
  Const MaxCol = 3
  '-----------------------------'
  Dim Data_A, Data_B
  Dim I&, J&, m&, K&, LR_A&, LR_B&
  Dim Data, sRng$, LR&, Col%, WS As Worksheet
  '-----------------------------'
  Set WS = WB.Worksheets("Data")
  sRng = "A1": Col = MaxCol
  GoSub GetData: LR_A = LR: Data_A = Data
  '-----------------------------'
  Set WS = WB.Worksheets("Ma")
  sRng = "A1": Col = 1
  GoSub GetData: LR_B = LR: Data_B = Data
  '-----------------------------'
  ReDim kQarr(1 To LR_A, 1 To MaxCol)
  '-----------------------------'
  For J = 1 To LR_B
    For I = 1 To LR_A
      If Data_A(I, 1) = Data_B(J, 1) Then
        K = K + 1 'Or ReDim Preserve -> Transpore'
        For m = 1 To MaxCol
          kQarr(K, m) = Data_A(I, m)
        Next m
      End If
  Next I, J
  '-----------------------------'
  If K = 0 Then GoTo Ends
  With WB.Worksheets("KetQua").[B5]
    .Resize(Rows.Count - .Row, MaxCol).ClearContents
    .Resize(K, MaxCol).Value = kQarr
  End With
Ends:
  Set WB = Nothing: Set WS = Nothing
  Exit Sub
GetData:
  With WS.Range(sRng)
    LR = .Offset(Rows.Count - .Row, 1).End(xlUp).Row - .Row + 1
    If (.Value = vbNullString And LR = 1) Or LR < 1 Then GoTo Ends
    Data = .Resize(LR, Col).Value
  End With
Return
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Thớt trúng số nhé. Muốn học nhiều chiêu thì chuyến này được ngay cái "quái chiêu" tuyệt đỉnh.
Nếu hiểu được chiêu này của tác giả thì đường lên luận kiếm Hoa Sơn không còn xa đâu.
 
Upvote 0
Nếu hiểu được chiêu này của tác giả thì đường lên luận kiếm Hoa Sơn không còn xa đâu.
Đối với mỗi người thì sẽ học code chuyên sâu hay là không chuyên sâu
Đối với em, học code để áp dụng vào lĩnh vực mình làm việc sao nó mang tính chính xác nhất, rồi đến không bị lỗi, còn thời gian nhanh hay chậm vài giây thì không thành vấn đề
Vì thế em chẳng cần học tuyệt chiêu gì, miễn sao nó đạt được yêu cầu như trên là được, chứ không phải để hơn thua với ai.
Trong quá trình học rồi thử nghiệm mà thấy code sai hay bị lỗi thì sẽ hỏi
và những vấn đề hỏi thì em cũng đã tìm hiểu rồi và vấn đề đó nó vượt kiến thức mình đang có thì em mới hỏi
Nói thật, dù sao em thấy mình vẫn hơn những người không biết mà không dám hỏi (những người dấu dốt) thế thôi
 
Upvote 0
Ủa hôm nào mới đòi học "đủ mọi kiểu" sao bây giờ thành "áp dụng" và "chính xác" vậy.
áp dụng thuộc về phân tích vấn đề, chính xác thuộc về kiểm soát kết quả.

Nói chuyện chơi chút thôi. Thớt muốn học gì tôi chẳng quan tâm lắm. Chỉ là lâu lắm mới thấy có người dùng từ khoá GoSub cho nên sẵn tiện tôi nhắc nhở các bạn (khác) muốn học code thì nên hỏi lại tác giả giải thích lý do tại sao dùng từ khoá này.
Đây là lời khuyên thật chứ không đùa. Phân biệt được GoSub và Call là trình độ code đã trên căn bản rồi. Nên nắm cơ hội mà học.
 
Lần chỉnh sửa cuối:
Upvote 0
Ủa hôm nào mới đòi học "đủ mọi kiểu" sao bây giờ thành "áp dụng" và "chính xác" vậy.
Ở chủ đề trên, bài 9 có viết
VetMini đã viết:
Thắc mắc: học chi nhiều cái chi tiết thế này. Nhớ sao hết.
Đúng là nhớ không hết
Nhưng em lập chủ đề này để nhiều người khác cùng đọc
1/ Để họ tự chọn 1 cách nào để áp dụng
2/ Khi họ đọc 1 chủ đề khác mà có code tương tự thì họ sẽ hiểu đoạn code đó làm gì
 
Upvote 0
Lý luận không giúp cho việc học code đâu.

Muốn học để "hiểu đoạn code đó làm gì" [sic] thì đã được nhắc rồi đó.
Tôi nhắc là vì tôi biết người mới học không hiểu nổi nếu không có giải thích.
 
Lần chỉnh sửa cuối:
Upvote 0
Web KT
Back
Top Bottom