Excel VBA Error en tiempo de ejecución '13' No coincide

Question

Creé una macro para un archivo y primero funcionaba bien, pero hoy he estado abriendo y reiniciando el archivo y la macro cientos de veces y siempre estoy obteniendo el siguiente error: Excel VBA Error en tiempo de ejecución '13' Tipo no coincidente

No cambié nada en la macro y no sé por qué recibo el error. Además, lleva años actualizar la macro cada vez que la ejecuto (la macro tiene que ejecutar alrededor de 9000 filas).

El error está en el entre ** **.

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 

¿Cree usted me puede ayudar? Estoy usando excel 2010 en Windows 7. Muchas gracias

Answer 1

Se produce un error de coincidencia si Sheets(name).Cells(4 + i, 57) contiene un valor no numérico. Debe validar los campos antes de suponer que son números y tratar de restarlos.

Además, debe habilitar Option Strict, por lo que se verá obligado a convertir explícitamente sus variables antes de intentar realizar operaciones dependientes del tipo tales como la resta. Eso lo ayudará a identificar y eliminar problemas en el futuro también.       Desafortunadamente Option Strict es solo para VB.NET. Aún así, debe buscar las mejores prácticas para las conversiones de tipos de datos explícitos en VBA.

---

Actualización:

Si usted está tratando de ir para la solución rápida de su código, sin embargo, envuelva la línea ** y el que le sigue en la siguiente condición:

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 

Tenga en cuenta que su valor x no puede contener su valor esperado en la siguiente iteración, sin embargo.

Answer 2

Diogo

Justin le ha dado algunos consejos muy bien :)

Usted también tendrá que error si la celda en la que está realizando el cálculo tiene un error resultante de una fórmula.

Por ejemplo, si la Celda A1 tiene # DIV/0! de error por lo que recibirá "Excel VBA en tiempo de ejecución Error '13' No coinciden los tipos" cuando se realiza este código

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

he hecho algunos pequeños cambios en el código. ¿Podrías probarlo por mí? Copie el código con los números de línea, ya que los coloqué deliberadamente allí.

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

Gracias a todos por toda su ayuda! ¡Finalmente pude hacer que funcione perfectamente gracias a un amigo y también a ti! Aquí está el código final para que también pueda ver cómo lo resolvemos.

¡Gracias nuevamente!

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

Tuve el mismo problema que mencionaste aquí arriba y mi código estuvo muy bien todo el día de ayer.

Seguí programando esta mañana y cuando abrí mi aplicación (mi archivo con un sub Auto_Open), recibí el error de "13" en tiempo de ejecución, no coinciden, fui a la web para buscar respuestas, probé una muchas cosas, modificaciones y en un momento recordé que leí en alguna parte sobre los datos de "Fantasmas" que permanecen en una celda incluso si no los vemos.

Mi código solo transfiere datos desde un archivo que abrí anteriormente a otro y lo suma. Mi código se detuvo en el tercer SheetTab (por lo que fue correcto para los 2 SheetTab anteriores, donde el mismo código se ejecutó sin parar) con el mensaje Type mismatch. Y lo hace cada vez en la misma SheetTab cuando reinicio mi código.

Así que seleccioné la celda donde se detuvo, ingresé manualmente 0,00 (porque la discrepancia de tipos proviene de las variables de suma declaradas en un DIM como doble) y copié esa celda en todas las celdas subsiguientes donde ocurrió el mismo problema. Solucionó el problema. Nunca tuve el mensaje de nuevo. Nada que ver con mi código, pero el "fantasma" o datos del pasado. Es como cuando desea utilizar el Control + Fin y Excel lo lleva donde tenía datos una vez y lo elimina. Tuve que "Guardar" y cerrar el archivo cuando deseaba utilizar el Control + Fin para asegurarse de que Excel lo apuntara a la celda correcta.

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

Este error se produce cuando el tipo de variable de entrada es incorrecto. Probablemente haya escrito una fórmula en Cells(4 + i, 57) que en lugar de =0, se haya utilizado la fórmula = "". Entonces cuando se ejecuta este error se muestra. Porque la cadena vacía no es igual a cero.