各印刷後にセルの値を自動的に増分させるにはどうすればよいですか？

例えば、100部印刷する必要のあるワークシートページがあり、セルA1にはチェック番号として「Company-001」が入力されているとします。ここで、各印刷後にその番号を1ずつ増やしたいのです。つまり、2部目の印刷時には番号が自動的に「Company-002」になり、3部目では「Company-003」、そして100部目では「Company-100」になるようにしたいのです。Excelでこの問題を迅速かつ簡単に解決する方法はありますか？

VBAコードを使用して、各印刷後にセルの値を自動的に増分させる

VBAコードを使用して、各印刷後にセルの値を自動的に増分させる

通常、Excelでこのタスクを直接解決する方法はありませんが、ここではVBAコードを作成して対処します。

1. ALT + F11 キーを押したままにし、Microsoft Visual Basic for Applications ウィンドウを開きます。

2. 「挿入」> 「モジュール」をクリックし、次のコードをモジュールウィンドウに貼り付けます。

VBAコード: 各印刷後にセルの値を自動的に増分させる:

Sub IncrementPrint()
'updateby Extendoffice
    Dim xCount As Variant
    Dim xScreen As Boolean
    Dim I As Long
    On Error Resume Next
LInput:
    xCount = Application.InputBox("Please enter the number of copies you want to print:", "Kutools for Excel")
    If TypeName(xCount) = "Boolean" Then Exit Sub
    If (xCount = "") Or (Not IsNumeric(xCount)) Or (xCount < 1) Then
        MsgBox "error entered, please enter again", vbInformation, "Kutools for Excel"
        GoTo LInput
    Else
        xScreen = Application.ScreenUpdating
        Application.ScreenUpdating = False
        For I = 1 To xCount
            ActiveSheet.Range("A1").Value = " Company-00" & I
            ActiveSheet.PrintOut
        Next
        ActiveSheet.Range("A1").ClearContents
        Application.ScreenUpdating = xScreen
    End If
End Sub

3. その後、F5キーを押してこのコードを実行すると、現在のワークシートを印刷したい部数を入力するよう促すダイアログボックスが表示されます。スクリーンショットをご覧ください：

4. 「OK」ボタンをクリックすると、現在のワークシートが印刷され始め、同時に印刷されたワークシートには、必要な通りにセルA1に「Company-001」、「Company-002」、「Company-003」…という番号が振られます。

注釈: 上記のコードでは、セルA1に指定した連続した番号が挿入され、A1の元のセルの値はクリアされます。「Company-00」はシーケンス番号であり、必要に応じて変更できます。