ファイルのマクロを作成し、最初は正常に機能していましたが、今日は何百回もファイルとマクロを開いて再起動しており、常に次のエラーが表示されます:Excel VBAランタイムエラー '13'タイプミスマッチ
マクロで何も変更しなかったので、なぜエラーが発生するのかわかりません。さらに、マクロを実行するたびにマクロを更新するには時間がかかります(マクロは約9000行実行する必要があります)。
エラーは** **の間にあります。
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
あなたは私を助けることができると思いますか? Windows 7でExcel 2010を使用しています。ありがとうございます。
Sheets(name).Cells(4 + i, 57)
に数値以外の値が含まれる場合、タイプの不一致が発生します。フィールドが数字であると仮定する前にフィールドを検証し、それらから減算を試みる必要があります。
また、 残念ながらOption Strict
を有効にする必要があります。これにより、変数のタイプ依存操作(減算など)を実行する前に、変数を明示的に変換する必要があります。これは、将来の問題を特定して排除するのにも役立ちます。Option Strict
はVB.NET専用です。それでも、VBAでの明示的なデータ型変換のベストプラクティスを調べる必要があります。
更新:
ただし、コードの簡単な修正を試みている場合は、**
行とそれに続く行を次の条件でラップします。
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
ただし、次の反復では、x
値に期待される値が含まれない場合があります。
皆さん、助けてくれてありがとう!最後に、友人とあなたのおかげで完璧に機能させることができました!ここに最終コードがありますので、どのように解決するかを見ることができます。
再度、感謝します!
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
ディオゴ
ジャスティンはあなたにいくつかの非常に素晴らしいヒントを与えました:)
また、計算を実行しているセルに式に起因するエラーがある場合にも、そのエラーが発生します。
たとえば、セルA1に#DIV/0がある場合!エラーが発生すると、このコードを実行すると「Excel VBA実行時エラー '13'型の不一致」が発生します
Sheets("Sheet1").Range("A1").Value - 1
コードに若干の変更を加えました。試してください。行番号を付けてコードをコピーします。意図的にそこに配置しました。
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
将来の読者向け:
この関数はRun-time error '13': Type mismatch
で異常終了していました
Function fnIsNumber(Value) As Boolean
fnIsNumber = Evaluate("ISNUMBER(0+""" & Value & """)")
End Function
私の場合、#DIV/0!
またはN/A
の値に遭遇したとき、関数は失敗していました。
それを解決するために、私はこれをしなければなりませんでした:
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
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
上記の問題と同じ問題があり、昨日、私のコードは一日中うまくいっていました。
私は今朝プログラミングを続け、アプリケーション(Auto_Openサブを含むファイル)を開いたときに、ランタイムエラー '13'のタイプの不一致が発生し、Webで回答を見つけて、多くのことを試しました。ある時点で、セルが表示されていなくてもセルに残る「ゴースト」データについてどこかで読んだことを思い出しました。
私のコードは、以前に開いたファイルから別のファイルへのデータ転送のみを行い、それを合計します。私のコードは3番目のSheetTabで停止し(同じコードが停止せずに移動した2つの前のSheetTabで正しくなりました)、タイプ不一致メッセージが表示されました。そして、同じSheetTabでコードを再起動するたびにそれを行います。
そこで、停止したセルを選択し、手動で0,00を入力しました(DIMでDoubleとして宣言されたSummation変数が原因であるため)。同じ問題が発生したすべての後続セルにそのセルをコピーしました。問題を解決しました。二度とメッセージがなかった。私のコードとは何の関係もなく、「ゴースト」または過去のデータだけです。 Ctrlキーを押しながらEndキーを押して、Excelでデータがあった場所を一度削除して削除したときのようなものです。 Ctrlキーを押しながらEndキーを押してExcelが正しいセルを示していることを確認したい場合は、ファイルを「保存」して閉じなければなりませんでした。