Excel VBA Lỗi thời gian chạy '13' Loại không phù hợp

Question

Tôi đã tạo macro cho tệp và trước tiên nó hoạt động tốt, nhưng hôm nay tôi đã mở và khởi động lại tệp và macro hàng trăm lần và tôi luôn nhận được lỗi sau: Lỗi thời gian chạy VBA Excel '13' Loại không khớp

Tôi không thay đổi bất kỳ điều gì trong macro và không biết tại sao tôi gặp lỗi. Hơn nữa phải mất nhiều thời gian để cập nhật macro mỗi khi tôi chạy nó (macro phải chạy khoảng 9000 hàng).

Lỗi nằm ở giữa ** **.

VBA:

Sub k() 

Dim x As Integer, i As Integer, a As Integer 
Dim name As String 
name = InputBox("Please insert the name of the sheet") 
i = 1 
Sheets(name).Cells(4, 58) = Sheets(name).Cells(4, 57) 
x = Sheets(name).Cells(4, 57).Value 
Do While Not IsEmpty(Sheets(name).Cells(i + 4, 57)) 
    a = 0 
    If Sheets(name).Cells(4 + i, 57) <> x Then 
     If Sheets(name).Cells(4 + i, 57) <> 0 Then 
      If Sheets(name).Cells(4 + i, 57) = 3 Then 
       a = x 
       Sheets(name).Cells(4 + i, 58) = Sheets(name).Cells(4 + i, 57) - x 
       x = Cells(4 + i, 57) - x 
      End If 
      **Sheets(name).Cells(4 + i, 58) = Sheets(name).Cells(4 + i, 57) - a** 
      x = Sheets(name).Cells(4 + i, 57) - a 
     Else 
     Cells(4 + i, 58) = "" 
     End If 
    Else 
    Cells(4 + i, 58) = "" 
    End If 

i = i + 1 
Loop 

End Sub 

Bạn có nghĩ rằng bạn có thể giúp tôi? Tôi đang sử dụng excel 2010 trên windows 7. Cảm ơn rất nhiều

Answer 1

Bạn sẽ nhận được loại không phù hợp nếu Sheets(name).Cells(4 + i, 57) chứa giá trị không phải là số. Bạn nên xác nhận các trường trước khi bạn cho rằng chúng là số và cố gắng trừ chúng.

Ngoài ra, bạn nên bật Option Strict để bạn buộc phải chuyển đổi rõ ràng các biến của mình trước khi cố gắng thực hiện các hoạt động phụ thuộc vào chúng như trừ. Điều đó cũng sẽ giúp bạn xác định và loại bỏ các vấn đề trong tương lai.       Thật không may Option Strict chỉ dành cho VB.NET. Tuy nhiên, bạn nên tìm kiếm các phương pháp hay nhất để chuyển đổi loại dữ liệu rõ ràng trong VBA.

---

Cập nhật:

Nếu bạn đang cố gắng để đi cho sửa chữa nhanh chóng mã của bạn, tuy nhiên, quấn dòng ** và một sau nó trong điều kiện sau đây:

If IsNumeric(Sheets(name).Cells(4 + i, 57)) 
    Sheets(name).Cells(4 + i, 58) = Sheets(name).Cells(4 + i, 57) - a 
    x = Sheets(name).Cells(4 + i, 57) - a 
End If 

Lưu ý rằng giá trị x của bạn có thể không chứa giá trị kỳ vọng của nó trong lần lặp tiếp theo.

Answer 2

Diogo

Justin đã đưa cho bạn một số lời khuyên rất tốt :)

Bạn cũng sẽ nhận được lỗi rằng nếu các tế bào mà bạn đang thực hiện việc tính toán có lỗi phát sinh từ một công thức.

Ví dụ: nếu ô A1 có # DIV/0! lỗi sau đó bạn sẽ nhận được "lỗi thời gian chạy Excel VBA '13' Loại không phù hợp" khi thực hiện mã này

Sheets("Sheet1").Range("A1").Value - 1 

Tôi đã thực hiện một số thay đổi nhỏ đối với mã của bạn. Bạn có thể kiểm tra nó cho tôi không? Sao chép mã với số dòng như tôi đã cố tình đặt chúng ở đó.

Option Explicit 

Sub Sample() 
    Dim ws As Worksheet 
    Dim x As Integer, i As Integer, a As Integer, y As Integer 
    Dim name As String 
    Dim lastRow As Long 
10  On Error GoTo Whoa 

20  Application.ScreenUpdating = False 

30  name = InputBox("Please insert the name of the sheet") 

40  If Len(Trim(name)) = 0 Then Exit Sub 

50  Set ws = Sheets(name) 

60  With ws 
70   If Not IsError(.Range("BE4").Value) Then 
80    x = Val(.Range("BE4").Value) 
90   Else 
100    MsgBox "Please check the value of cell BE4. It seems to have an error" 
110    GoTo LetsContinue 
120   End If 

130   .Range("BF4").Value = x 

140   lastRow = .Range("BE" & Rows.Count).End(xlUp).Row 

150   For i = 5 To lastRow 
160    If IsError(.Range("BE" & i)) Then 
170     MsgBox "Please check the value of cell BE" & i & ". It seems to have an error" 
180     GoTo LetsContinue 
190    End If 

200    a = 0: y = Val(.Range("BE" & i)) 
210    If y <> x Then 
220     If y <> 0 Then 
230      If y = 3 Then 
240       a = x 
250       .Range("BF" & i) = Val(.Range("BE" & i)) - x 

260       x = Val(.Range("BE" & i)) - x 
270      End If 
280      .Range("BF" & i) = Val(.Range("BE" & i)) - a 
290      x = Val(.Range("BE" & i)) - a 
300     Else 
310      .Range("BF" & i).ClearContents 
320     End If 
330    Else 
340     .Range("BF" & i).ClearContents 
350    End If 
360   Next i 
370  End With 

LetsContinue: 
380  Application.ScreenUpdating = True 
390  Exit Sub 
Whoa: 
400  MsgBox "Error Description :" & Err.Description & vbNewLine & _ 
     "Error at line  : " & Erl 
410  Resume LetsContinue 
End Sub 

Answer 3

Cảm ơn các bạn đã giúp đỡ! Cuối cùng tôi đã có thể làm cho nó hoạt động hoàn hảo nhờ một người bạn và cũng là bạn! Đây là mã cuối cùng để bạn cũng có thể xem cách chúng tôi giải quyết nó.

Cảm ơn bạn lần nữa!

Option Explicit 

Sub k() 

Dim x As Integer, i As Integer, a As Integer 
Dim name As String 
'name = InputBox("Please insert the name of the sheet") 
i = 1 
name = "Reserva" 
Sheets(name).Cells(4, 57) = Sheets(name).Cells(4, 56) 

On Error GoTo fim 
x = Sheets(name).Cells(4, 56).Value 
Application.Calculation = xlCalculationManual 
Do While Not IsEmpty(Sheets(name).Cells(i + 4, 56)) 
    a = 0 
    If Sheets(name).Cells(4 + i, 56) <> x Then 
     If Sheets(name).Cells(4 + i, 56) <> 0 Then 
      If Sheets(name).Cells(4 + i, 56) = 3 Then 
       a = x 
       Sheets(name).Cells(4 + i, 57) = Sheets(name).Cells(4 + i, 56) - x 
       x = Cells(4 + i, 56) - x 
      End If 
      Sheets(name).Cells(4 + i, 57) = Sheets(name).Cells(4 + i, 56) - a 
      x = Sheets(name).Cells(4 + i, 56) - a 
     Else 
     Cells(4 + i, 57) = "" 
     End If 
    Else 
    Cells(4 + i, 57) = "" 
    End If 

i = i + 1 
Loop 
Application.Calculation = xlCalculationAutomatic 
Exit Sub 
fim: 
MsgBox Err.Description 
Application.Calculation = xlCalculationAutomatic 
End Sub 

Answer 4

Tôi đã gặp vấn đề tương tự như bạn đã đề cập ở trên và mã của tôi đã hoạt động tốt cả ngày hôm qua.

Tôi tiếp tục lập trình sáng nay và khi mở ứng dụng (tệp của tôi có phụ Auto_Open), tôi gặp lỗi thời gian chạy '13' Loại không phù hợp, tôi truy cập web để tìm câu trả lời, tôi đã thử rất nhiều thứ, sửa đổi và tại một thời điểm tôi nhớ rằng tôi đã đọc ở đâu đó về dữ liệu "Ghost" nằm trong một ô ngay cả khi chúng ta không nhìn thấy nó.

Mã của tôi chỉ chuyển dữ liệu từ một tệp mà tôi đã mở trước đó và tổng hợp nó. Mã của tôi dừng lại ở SheetTab thứ ba (Vì vậy, nó đã đi đúng cho 2 SheetTab trước đó trong đó cùng một mã đã đi mà không dừng lại) với thông báo Type mismatch. Và nó làm điều đó mọi lúc tại cùng một SheetTab khi tôi khởi động lại mã của mình. Vì vậy, tôi đã chọn ô mà nó dừng lại, được nhập bằng tay 0,00 (Vì Loại không khớp xuất phát từ một biến Tổng kết được khai báo trong DIM dưới dạng Đôi) và sao chép ô đó trong tất cả các ô tiếp theo mà cùng một sự cố xảy ra. Nó giải quyết được vấn đề. Không bao giờ có tin nhắn nữa. Không có gì để làm với mã của tôi nhưng "Ghost" hoặc dữ liệu từ quá khứ. Nó giống như khi bạn muốn sử dụng Control + End và Excel sẽ đưa bạn đến nơi bạn đã có dữ liệu một lần và xóa nó. Đã phải "Lưu" và đóng tệp khi bạn muốn sử dụng Control + End để đảm bảo Excel đã trỏ bạn đến ô bên phải.

Answer 5

Sub HighlightSpecificValue() 

'PURPOSE: Highlight all cells containing a specified values 


Dim fnd As String, FirstFound As String 
Dim FoundCell As Range, rng As Range 
Dim myRange As Range, LastCell As Range 

'What value do you want to find? 
    fnd = InputBox("I want to hightlight cells containing...", "Highlight") 

    'End Macro if Cancel Button is Clicked or no Text is Entered 
     If fnd = vbNullString Then Exit Sub 

Set myRange = ActiveSheet.UsedRange 
Set LastCell = myRange.Cells(myRange.Cells.Count) 

enter code here 
Set FoundCell = myRange.Find(what:=fnd, after:=LastCell) 

'Test to see if anything was found 
    If Not FoundCell Is Nothing Then 
    FirstFound = FoundCell.Address 

    Else 
    GoTo NothingFound 
    End If 

Set rng = FoundCell 

'Loop until cycled through all unique finds 
    Do Until FoundCell Is Nothing 
    'Find next cell with fnd value 
     Set FoundCell = myRange.FindNext(after:=FoundCell) 







    'Add found cell to rng range variable 
     Set rng = Union(rng, FoundCell) 

    'Test to see if cycled through to first found cell 
     If FoundCell.Address = FirstFound Then Exit Do 


    Loop 

'Highlight Found cells yellow 

    rng.Interior.Color = RGB(255, 255, 0) 

    Dim fnd1 As String 
    fnd1 = "Rah" 
    'Condition highlighting 

    Set FoundCell = myRange.FindNext(after:=FoundCell) 



    If FoundCell.Value("rah") Then 
     rng.Interior.Color = RGB(255, 0, 0) 

    ElseIf FoundCell.Value("Nav") Then 

    rng.Interior.Color = RGB(0, 0, 255) 



    End If 





'Report Out Message 
    MsgBox rng.Cells.Count & " cell(s) were found containing: " & fnd 

Exit Sub 

'Error Handler 
NothingFound: 
    MsgBox "No cells containing: " & fnd & " were found in this worksheet" 

End Sub 

Answer 6

Lỗi này xảy ra khi loại biến đầu vào sai. Bạn có thể đã viết một công thức trong Cells(4 + i, 57) thay vì =0, công thức = "" đã được sử dụng. Vì vậy, khi chạy lỗi này được hiển thị. Bởi vì chuỗi rỗng không bằng 0.