Erreur d'exécution VBA Excel '13' Incompatibilité de type
J'ai créé une macro pour un fichier et tout d'abord, il fonctionnait bien, mais aujourd'hui, j'ai ouvert et redémarré le fichier et la macro des centaines de fois et j'obtiens toujours l'erreur suivante: Excel VBA Erreur d'exécution '13' Type décalage
Je n'ai rien changé dans la macro et je ne sais pas pourquoi je reçois l'erreur. En outre, il faut du temps pour mettre à jour la macro chaque fois que je la mets en marche (la macro doit exécuter environ 9 000 lignes).
L'erreur est 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
Pensez-vous que vous pouvez m'aider? J'utilise Excel 2010 sur Windows 7 . Merci beaucoup
Vous obtiendrez une incompatibilité de type si Sheets(name).Cells(4 + i, 57) contient une valeur non numérique. Vous devez valider les champs avant de supposer que ce sont des nombres et essayer de les soustraire.
En outre, vous devez activer Malheureusement, Option Strict pour vous obliger à convertir explicitement vos variables avant d'essayer d'effectuer des opérations dépendantes du type telles que la soustraction. Cela vous aidera également à identifier et à éliminer les problèmes à l'avenir.Option Strict est uniquement destiné à VB.NET. Vous devez néanmoins rechercher les meilleures pratiques pour les conversions de types de données explicites dans VBA.
Mettre à jour:
Toutefois, si vous essayez d'utiliser la solution rapide de votre code, enveloppez la ligne ** et celle qui la suit dans la condition suivante:
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
Notez que votre valeur x peut ne pas contenir la valeur attendue lors de la prochaine itération.
Merci beaucoup pour votre aide! Enfin, j'ai pu le faire fonctionner parfaitement grâce à un ami et à vous!!. Voici le code final afin que vous puissiez également voir comment nous le résolvons.
Merci encore!
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
Diogo
Justin vous a donné de très bons conseils :)
Vous obtiendrez également cette erreur si la cellule dans laquelle vous effectuez le calcul contient une erreur résultant d'une formule.
Par exemple, si la cellule A1 a # DIV/0! erreur alors vous obtiendrez "Erreur d'exécution VBA Excel '13' incompatibilité de type" lors de l'exécution de ce code
Sheets("Sheet1").Range("A1").Value - 1
J'ai légèrement modifié votre code. Pourriez-vous s'il vous plaît tester pour moi? Copiez le code avec les numéros de ligne tels que je les ai volontairement mis ici.
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
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
Cette erreur se produit lorsque le type de variable d'entrée est incorrect. Vous avez probablement écrit une formule dans Cells(4 + i, 57) qu’au lieu de =0, la formule = "" a été utilisée. Donc, lors de l'exécution, cette erreur est affichée. Parce que la chaîne vide n'est pas égale à zéro.
J'ai eu le même problème que vous avez mentionné ci-dessus et mon code se passait bien toute la journée hier.
J'ai continué à programmer ce matin et quand j'ai ouvert mon application (mon fichier avec un sous-marin Auto_Open), j'ai eu l'erreur d'exécution "13" Type mismatch, je suis allée sur le Web pour trouver des réponses, j'ai essayé beaucoup de choses, modifications et à un moment donné, je me suis rappelé que j'avais lu quelque part à propos de données "Ghost" qui restaient dans une cellule même si nous ne les voyions pas.
Mon code ne fait que transférer des données d'un fichier que j'ai précédemment ouvert à un autre et le résumer. Mon code s'est arrêté à la troisième SheetTab (Donc, cela s'est bien passé pour les 2 précédentes SheetTab où le même code est resté sans s'arrêter) avec le message d'incompatibilité de type. Et cela se fait chaque fois dans le même SheetTab lorsque je redémarre mon code.
J'ai donc sélectionné la cellule où elle s'est arrêtée, entré manuellement 0,00 (étant donné que l'incompatibilité de type provient d'une variable de somme déclarée dans un DIM comme étant double) et copié cette cellule dans toutes les cellules suivantes où le même problème s'est produit. Cela a résolu le problème. Je n'ai plus jamais eu le message. Rien à voir avec mon code mais le "Ghost" ou les données du passé. C'est comme quand vous voulez utiliser Control + End et Excel vous emmène là où vous aviez des données une fois et les a supprimées. Devait "Enregistrer" et fermer le fichier lorsque vous vouliez utiliser les touches Ctrl + Fin pour vous assurer que Excel vous dirigeait vers la bonne cellule.
Pour les futurs lecteurs:
Cette fonction était en suspens dans Run-time error '13': Type mismatch
Function fnIsNumber(Value) As Boolean
fnIsNumber = Evaluate("ISNUMBER(0+""" & Value & """)")
End Function
Dans mon cas, la fonction échouait lorsqu'elle rencontrait une valeur #DIV/0! ou N/A.
Pour le résoudre, je devais faire ceci:
Function fnIsNumber(Value) As Boolean
If CStr(Value) = "Error 2007" Then '<===== This is the important line
fnIsNumber = False
Else
fnIsNumber = Evaluate("ISNUMBER(0+""" & Value & """)")
End If
End Function