- 締切済み
複数シートにわたる連番を自動作成するfunctio
複数シートにわたる連番を自動作成するfunction関数をoffice 365のEXCELで作りました。 variant型で定義しており、連番途中に右側のセルが空白だった場合、対象セルを空白にし、上のセルが空白だった場合は、数字が出てくるセルまで上に行き+1します。 左端のシート以外の最上のセルは左のシートの最大の数字+1に設定しています。 Function renban1() As Variant Dim temp As Integer, a_row As Long, a_col As Long Dim range1 As Range, ind As Integer Const a_spc = " " ind = ActiveSheet.Index a_row = ActiveCell.Row a_col = ActiveCell.Column renban1 = a_spc Set range1 = Range(Cells(a_row, a_col + 1), Cells(a_row, a_col + 7)) If a_col = 2 And a_row = 5 Then renban1 = 1 Exit Function End If If a_row = 12 And a_col = 2 Then If ind = 1 Then renban1 = 2 Exit Function Else If WorksheetFunction.CountA(range1) = 0 Then '右が空白 renban1 = a_spc Exit Function Else For temp = 80 To 12 Step -2 If ActiveSheet.Previous.Cells(temp, a_col).Value <> a_spc Then '上が空白以外≒数値 renban1 = ActiveSheet.Previous.Cells(temp, a_col).Value + 1 Exit Function End If Next temp End If End If End If If a_row > 10 And a_row < 82 Then '番号のセル範囲 If WorksheetFunction.CountA(range1) = 0 Then '右が空白 renban1 = a_spc Exit Function Else For temp = a_row - 2 To 12 Step -2 If Cells(temp, a_col).Value <> a_spc Then '上が空白以外≒数値 renban1 = Cells(temp, a_col).Value + 1 Exit Function End If Next temp End If End If End Function これで、動作自体は正しいのですが、いちいちセルをクリックしてENTERを押さないと正しく更新されません。(トリガーが無いので当然と言えなくもないのですが) 1シートに35行ほどあり、同様のシートが11枚あるので、出来れば自動で更新させたいのですが、calculateやapplication.volatileを試してもうまくいきませんでした。 VBAにお詳しい方、どうやれば良いか教えて下さい。よろしくお願い致します。
- みんなの回答 (3)
- 専門家の回答
お礼
ありがとうございます。 そうですね。突っ込みどころ満載ですね。 仰せに従って再質問させて頂きます。