配列のフリーズを解消してください。

質問

Sub データ原本()
Dim wsAll As Worksheet
Set wsAll = Worksheets("All(5)")
Dim lRow As Long, lCol As Long
Dim i As Long, j As Long, cnt As Long
With Worksheets("データ原本")

'日付S行を日付に変更(「.」を「/」に置換)
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
Dim MyArray As Variant
MyArray = Range(.Cells(10, 1), .Cells(lRow, 1))
For i = 1 To lRow - 9
MyArray(i, 1) = Replace(MyArray(i, 1), ".", "/")
Next
Range(.Cells(10, 1), .Cells(lRow, 1)) = MyArray
Erase MyArray '配列の初期化

'「天気」両サイドの &「内・外」両サイドの空白スペースを削除
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
MyArray = Range(.Cells(10, TNK), .Cells(lRow, TNK))
For i = 1 To lRow - 9
MyArray(i, 1) = Trim(MyArray(i, 1))
Next
Range(.Cells(10, TNK), .Cells(lRow, TNK)) = MyArray
Erase MyArray '配列の初期化

'数値0のデータ行の行削除
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
lCol = .Cells(9, Columns.Count).End(xlToLeft).Column
Dim arr_A As Variant, arr_B As Variant

arr_A = Range(.Cells(9, 1), .Cells(lRow, lCol)).Value
ReDim arr_B(1 To lRow - 8, 1 To lCol)

cnt = 0

For i = 1 To lRow - 8
If arr_A(i, 18) <> 0 Then
cnt = cnt + 1
For j = 1 To lCol
arr_B(cnt, j) = arr_A(i, j)
Next j
End If
Next i

.Range("A9").Resize(lRow, lCol).Value = arr_B
End With
End Sub

　上記のコードを2回実行すると2回目には、
MyArray(i, 1) = Replace(MyArray(i, 1), ".", "/")のところで「型が一致しません。」とフリーズします。かと言って 「 '数値0のデータ行の行削除」コードを一括削除して、実行ボタンを何度押してもフリーズすることはありません。どこに不具合が生じているのかわからないのですが、どなたか名回答を宜しくお願いします。

回答No.1

kkkkkm · ベストアンサー

.Range("A9").Resize(lRow, lCol).Value = arr_B
Resizeの範囲が広すぎますので超えた部分が#N/Aになってそこでエラーになっています。

.Range("A9").Resize(lRow - 8, lCol).Value = arr_B

で試してみてください。