VBAのファイル参照について
セルの変更時、列によって行の内容を変更するプログラムを組んだのですが、
エラーが起きてうまくいきません。
使用しているExcelは2007です。
ファイルを参照するあたりが全然わかってないのでそのあたりがあやしいです。
実行時エラー '91':
オブジェクト変数または With ブロック変数が設定されていません。
→ hoge = book1.Worksheets(customer).Range("A34:D" & endrow) '係数表をコピー
↓デバッグ押すと
実行時エラー '-2147417848 (80010108)':
'Value' メソッドは失敗しました: 'Range'オブジェクト
→ Call all_feeCulc_change2(target.Parent.Name, target.row)
番号をメモし忘れました。91かこれが表示されます。どちらが出るかわかりません。
'Range' メソッドは失敗しました:'_Worksheet' オブジェクト
→endrow = book1.Worksheets(customer).Cells(Rows.Count, 1).End(xlUp).row '最終行番号を取得
何回かリトライして開いたり閉じたりを繰り返したら↓のようなダイアログも出ました。
マクロでスタック領域が不足しています
また、ダイアログで終了を押したらセルを正しく選択できなくなりました。
デバッグを押したら、停止ボタンを押すと応答なしになった後、Excelが終了し再起動しました。
そして、どちらを選択した場合でも、メニューや閉じるボタンを押してもExcelが終了できず、
タスクマネージャからプロセスを終了させるしかなかったです。
その時CPU使用率が50%を超えてたりと異常事態になっております。
###標準モジュール###
Sub all_feeCulc_change2(ByVal sheetName As String, ByVal row As Integer)
If sheetName <> "" Then
Dim customer As String
customer = Worksheets(sheetName).Cells(row, 3)
On Error Resume Next
Dim book1 As Workbook '別ファイルのオープン（触らない）
Workbooks.Open Filename:="hogehoge.xlsm" '別ファイルのオープン（触らない）
Set book1 = Workbooks("hogehoge.xlsm") '別ファイルのオープン（触らない）
On Error GoTo 0
Dim endrow As Integer '最終行番号
endrow = book1.Worksheets(customer).Cells(Rows.Count, 1).End(xlUp).row '最終行番号を取得
Dim hoge As Variant
hoge = book1.Worksheets(customer).Range("A34:D" & endrow) '早見表から係数表をコピー
With Worksheets(sheetName)
...
###ThisWorkbook###
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal target As Range)
If target.Count = 1 Then
Dim column As Integer
Dim row As Integer
column = target.column
row = target.row
If row >= 3 Then
If ((column - 3) Mod 5) = 2 And column > 3 Then '更新セルがメーターだったら
Call usageCulc_change(target.Parent.Name, target.column, target.row)
Call all_feeCulc_change(target.Parent.Name, target.column - 1, target.row)
Call chenge_tax_change(target.Parent.Name, target.column + 1, target.row)
ElseIf column = 3 Then
target.Value = format(target.Value, "000") '誤入力防止
Call all_feeCulc_change2(target.Parent.Name, target.row)
Call chenge_tax_change2(target.Parent.Name, target.row)
End If
End If
End If
End Sub
Private Sub Workbook_Open()
'*****すべてのシート名を取得*****'
Dim ws As Worksheet
Dim sheetName() As String
ReDim sheetName(3)
Dim cnt As Integer
cnt = 0
For Each ws In Worksheets
If cnt > 3 And (cnt Mod 4) = 0 Then
ReDim Preserve sheetName(UBound(sheetName) + 4)
End If
sheetName(cnt) = ws.Name
cnt = cnt + 1
Next
'*****取得終了*****'
Dim endrow As Integer
Dim line As Variant
For Each line In sheetName
If line <> "000" And line <> "" Then
With Worksheets(line)
endrow = .Cells(Rows.Count, 3).End(xlUp).row
Dim i As Integer
Dim j As Integer
For i = 0 To endrow
For j = 0 To 11
.Cells(3 + i, 4 + j * 5).NumberFormatLocal = "0.0"
.Cells(3 + i, 5 + j * 5).NumberFormatLocal = "0.0"
.Cells(3 + i, 6 + j * 5).NumberFormatLocal = "#,##0"
.Cells(3 + i, 7 + j * 5).NumberFormatLocal = "#,##0"
.Cells(3 + i, 8 + j * 5).NumberFormatLocal = "#,##0"
Next j
Next i
End With
End If
Next
End Sub
お礼
ご回答ありがとうございます。 出来ました。こんな簡単な問題で質問してしまって申し訳ないです。