Note: The other languages of the website are Google-translated. Back to English

 各印刷後にセル値を自動インクリメントするにはどうすればよいですか?

100部印刷する必要のあるワークシートページがあり、セルA1が小切手番号Company-001であるとすると、印刷するたびに番号を1ずつ増やしてほしいと思います。 つまり、002部目を印刷すると、自動的にCompany-003になり、100部目は、Company-XNUMX…XNUMX部、Company-XNUMXになります。 Excelでこの問題をすばやくそしておそらく解決するためのトリックはありますか?

VBAコードで印刷するたびにセル値を自動インクリメント


矢印青い右バブル VBAコードで印刷するたびにセル値を自動インクリメント

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

1。 を押し続けます Alt + F11 キーを押して アプリケーション向け Microsoft Visual Basic 窓。

2に設定します。 OK をクリックします。 インセット > モジュール、次のコードをに貼り付けます モジュール 窓。

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 このコードを実行するためのキーを押すと、現在のワークシートを印刷する部数を入力するように促すプロンプトボックスが表示されます。スクリーンショットを参照してください。

1を印刷するときのドキュメントの増分

4に設定します。 OK をクリックします。 OK ボタンをクリックすると、現在のワークシートが印刷されます。同時に、印刷されたワークシートには、必要に応じてセルA001でCompany-002、Company-003、Company-1…の番号が付けられます。

注意:上記のコードでは、セル A1 注文したシーケンス番号と元のセル値が挿入されます A1 クリアされます。 そして「会社-00」はシーケンス番号です。必要に応じて変更できます。


最高のオフィス生産性ツール

Kutools for Excelはほとんどの問題を解決し、生産性を80%向上させます

  • 再利用: すばやく挿入 複雑な数式、チャート および以前に使用したものすべて。 セルを暗号化する パスワード付き。 メーリングリストを作成する そしてメールを送る...
  • スーパーフォーミュラバー (複数行のテキストと数式を簡単に編集できます); 読書レイアウト (多数のセルを簡単に読み取って編集する); フィルター範囲に貼り付け...
  • セル/行/列をマージする データを失うことなく; 分割セルコンテンツ; 重複する行/列を組み合わせる...重複セルを防止します。 範囲を比較する...
  • [複製]または[一意]を選択します 行; 空白行を選択 (すべてのセルは空です); スーパーファインドとファジーファインド 多くのワークブックで; ランダム選択...
  • 正確なコピー 数式参照を変更せずに複数のセル。 参照の自動作成 複数のシートに; 箇条書きを挿入、チェックボックスなど...
  • テキストを抽出、テキストの追加、位置による削除、 スペースを削除する; ページング小計の作成と印刷。 セルの内容とコメントを変換する...
  • スーパーフィルター (フィルタースキームを保存して他のシートに適用します); 高度な並べ替え 月/週/日、頻度など。 特殊フィルター 太字、斜体...
  • ワークブックとワークシートを組み合わせる; キー列に基づいてテーブルをマージします。 データを複数のシートに分割; xls、xlsx、PDFをバッチ変換...
  • 300 以上の強力な機能. Office / Excel 2007-2021 および 365 をサポートします。すべての言語をサポートします。 企業や組織に簡単に導入できます。 フル機能の 30 日間無料トライアル。 60日間の返金保証。
kteタブ201905

Officeタブは、タブ付きのインターフェイスをOfficeにもたらし、作​​業をはるかに簡単にします

  • Word、Excel、PowerPointでタブ付きの編集と読み取りを有効にする、パブリッシャー、アクセス、Visioおよびプロジェクト。
  • 新しいウィンドウではなく、同じウィンドウの新しいタブで複数のドキュメントを開いて作成します。
  • 生産性を 50% 向上させ、毎日何百回もマウス クリックを減らすことができます!
officetab下部
コメントを並べ替える
コメント (51)
まだ評価はありません。 最初に評価してください!
このコメントは、サイトのモデレーターによって最小化されました
このコードはすごいです、それはまさに私が必要としているものです、しかし、私はセル「A1」に入力された番号から印刷を開始する方法があるかどうか疑問に思いましたか? たとえば、100部を印刷した場合、次の印刷実行で101番から印刷し、そこからカウントアップする必要があります。 私はいくつかのコード調整を試しましたが、セルに入力された数字、つまり101だけを取り、1を足すと、残りの印刷物はその102つの数字、つまりXNUMXで動かなくなります...ご協力いただければ幸いです。 -)
このコメントは、サイトのモデレーターによって最小化されました
まだ解決策が見つからない場合は、コードの17行目を次のように編集できます:ActiveSheet.Range( "A1")。Value = Range( "A1")。Value + 1
これにより、A1セルにある数に+1が追加されます。
このコメントは、サイトのモデレーターによって最小化されました
プリンターに送信されません
このコメントは、サイトのモデレーターによって最小化されました
ボンジュール、

en exécutant la macro ça effface le nombre de ma cellule.
Je voudrais par exemple avoir A1= 153, je lance une impression de 10 コピー. J'ai dis feuilles imprimée de 154 à 164 ET je voudrais que le nombre de la cellule soit aussi 164.
Comme ça quand je relance unepression ça prend le chiffre dans A1.
J'aimerais aussi possible na pas à avoir aller dans basic. je voudrais que la macro s'active direction by l'optionpression. 可能ですか?
このコメントは、サイトのモデレーターによって最小化されました
ボンジュール、

en exécutant la macro ça effface le nombre en A1.

je voudrais si c'est possible par example A1=153 et faire unepression de 10 コピー. donc je récupéré 10 Impressions numérotées de 154 à 164 ET je voudrais aussi que le 153 en A1 s'incrémente jusqu'à 164.

Je voudrais aussi possible ne pas à avoir utiliser basic pour l'impression. je voudrais pouvoir declancher directement la macro en utilisant l'optionpression tout simplement.

ご協力いただきありがとうございます
このコメントは、サイトのモデレーターによって最小化されました
梶さん、こんにちは。
問題を解決するには、以下のコードを適用してください。
Sub IncrementPrint_Num()
Dim xCount As Variant
Dim xScreen As Boolean
Dim I As Long
Dim xInt As Integer
On Error Resume Next
xInt = 153 'number
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
xInt = xInt + 1
ActiveSheet.Range("A1").Value = xInt
ActiveSheet.PrintOut
Next
Application.ScreenUpdating = xScreen
End If
End Sub

他に問題がある場合は、ここにコメントしてください。
このコメントは、サイトのモデレーターによって最小化されました
添付されている変更されたコードを見つけます。

そしてここにそれはテキストにあります:
Sub IncrementPrint()
'updateby Extendoffice
バリアントとしての薄暗いxEnd
バリアントとしての薄暗いxStart
Dim xScreen をブール値として
薄暗い私は長く
エラーで次の再開
LInput:
xStart = Application.InputBox( "最初の数字を入力してください:"、 "Kutools forExcel")
xEnd = Application.InputBox( "最後の番号を入力してください:"、 "Kutools forExcel")
TypeName(xCount)= "Boolean"の場合、Subを終了します
If(xStart = "")Or(Not IsNumeric(xStart))Or(xStart <1)Then
MsgBox「エラーが入力されました。もう一度入力してください」、vbInformation、「KutoolsforExcel」
GoTo LInput

xScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
I = xStartToxEndの場合
ActiveSheet.Range( "A1")。Value = "Company-00"&I
ActiveSheet.PrintOut
次へ
ActiveSheet.Range( "A1")。ClearContents
Application.ScreenUpdating = xScreen
終了する場合
End Subの
このコメントは、サイトのモデレーターによって最小化されました
IA1-055242、IA1-055243、IA1-055244などのシリアル番号が必要です.....
このコメントは、サイトのモデレーターによって最小化されました
これを投稿していただきありがとうございます、それは非常に役に立ちます。 私の質問はこれです:2ページでインクリメントする必要があるXNUMXつの異なるバーコードがありますが、それを行うためにコードを変更するにはどうすればよいですか?
このコメントは、サイトのモデレーターによって最小化されました
別の投稿でこれを聞いて申し訳ありません...私のシリアル番号はゼロで始まりますが、プログラムを実行するとゼロが削除されます。 数値フィールドをテキストに変換しようとしましたが、修正されませんでした。 他のアイデア?
このコメントは、サイトのモデレーターによって最小化されました
R-セル、フォーマット、カスタムをクリックし、「一般」と表示されている場合は、シリアル番号と同じ数のゼロに置き換えます。 これにより、シリアル番号の前に必要なゼロの数が強制されます。 10桁のシリアル番号のグループがある場合は、[タイプ]フィールドに0000000000と入力して、[0004563571]をシリアル番号フィールドに表示します。
このコメントは、サイトのモデレーターによって最小化されました
アートありがとうございます。 私はそれを試しましたが、バーコードは先行ゼロを削除し続けました...カスタムの数値形式を実行した後でも。
このコメントは、サイトのモデレーターによって最小化されました
私のシリアル番号は227861で始まります。
このコメントは、サイトのモデレーターによって最小化されました
30部のように印刷されましたが、今は印刷できず、スクリプトを何度も実行しましたが、機能していません。何もしないでください:(
このコメントは、サイトのモデレーターによって最小化されました
上記をありがとう、本当に役に立ちました。 最後の値を保存して記憶することは可能ですか
このコメントは、サイトのモデレーターによって最小化されました
こんにちは、ピーター、
次回印刷するときに最後に印刷された値を保存して記憶するには、次のVBAコードを適用する必要があります。

Sub IncrementPrint()
バリアントとしての薄暗いxCount
Dim xScreen をブール値として
薄暗い私は長く
薄暗いxMと同じくらい
ワークシートとしての薄暗いxMNWS
ワークシートとしての薄暗いxAWS
エラーで次の再開
LInput:
xCount = Application.InputBox( "印刷する部数を入力してください:"、 "Kutools forExcel")
TypeName(xCount)= "Boolean"の場合、Subを終了します
If(xCount = "")Or(Not IsNumeric(xCount))Or(xCount <1)Then
MsgBox「エラーが入力されました。もう一度入力してください」、vbInformation、「KutoolsforExcel」
GoTo LInput

xScreen = Application.ScreenUpdating
xAWS=ActiveSheetを設定します
エラー時GoToEMarkNumberSheet
xMNWS = Sheets( "IncrementPrint_MarkNumberSheet")を設定します
EMarkNumberSheet:
xMNWSが何もない場合
xMNWS = Application.Worksheets.Add(Type:= xlWorksheet)を設定します
xMNWS.Name = "IncrementPrint_MarkNumberSheet"
xMNWS.Range( "A1")。Value = 0
xM = 0
xMNWS.Visible = xlSheetVeryHidden

xM = xMNWS.Range( "A1")。Value
終了する場合
Application.ScreenUpdating = False
I=1からxCountの場合
xM = xM + 1
xAWS.Range( "A1")。Value = "Company-00"&xM
xAWS.PrintOut
次へ
xMNWS.Range( "A1")。Value = xM
xAWS.Range( "A1")。ClearContents
Application.ScreenUpdating = xScreen
終了する場合
End Subの

印刷した番号をデフォルトの番号にリセットする必要がある場合は、最初に以下のコードを実行してから、上記のコードを実行して印刷してください。

Sub IncrementPrint_Reinstall()
ワークシートとしての薄暗いxMNWS
エラー時GoToEMarkNumberSheet
xMNWS = Sheets( "IncrementPrint_MarkNumberSheet")を設定します
EMarkNumberSheet:
そうでない場合、xMNWSは何もありません
Application.DisplayAlerts = False
xMNWS.Visible = xlSheetHidden
xMNWS.Delete
Application.DisplayAlerts = True
終了する場合
End Subの
このコメントは、サイトのモデレーターによって最小化されました
こんにちは、このコードをありがとう..質問があります。 私はこのコードを使用しましたが、シリーズは0071,0072,0073、3、1のようにジャンプしています。 シリーズ100-0032の間で101倍のように起こりました。 そのため、保存せずにvbaを閉じて、コードを再インストールしましたが、保存された最後のシリーズ(XNUMX)が出力されます。 私の質問は、シリーズがジャンプすることなく連続して印刷するにはどうすればよいですか?また、XNUMXから再印刷するにはどうすればよいですか? 本当にあなたの答えに感謝します。 ごめんなさい。 私はプログラマーではありません。ご理解いただければ幸いです。 ありがとうございました! 
このコメントは、サイトのモデレーターによって最小化されました
これを投稿していただきありがとうございます、それは非常に役に立ちます。 私の質問はこれです:2ページでインクリメントする必要があるXNUMXつの異なるバーコードがありますが、それを行うためにコードを変更するにはどうすればよいですか?
このコメントは、サイトのモデレーターによって最小化されました
こんにちはデズモンド、
2ページに2つの場所がある場合(2つのクーポンまたは2つのテンプレート/ 1つのバウチャーなど)、以下のコードを使用してみてください。 (2番目のバーコードと1番目のバーコードが同じページのセル「A20」と「A001」にあるとすると、このコードは、最初のページのCompany-002とCompany-003、004番目のページのCompany-20とCompany-21のような値をインクリメントします。コードの23、24、28,29、XNUMX、XNUMX、XNUMX行目で、セル番号と会社名を自由に編集できます。 
また、開始番号と終了番号の入力を求められます(コードのこの部分についてはgeniusmanに感謝します)。 だから例えばあなたの開始番号。 は1で、末尾はnoです。 8、4ページ目に1,2、1ページ目に3,4、2ページ目に5,6、最後に3ページ目に7,8の4ページを印刷します。 それがあなたやこの種のニーズ/要件を探している人に役立つことを願っています。 
変更されたコード:----------------------------------------------- ------------ Sub IncrementPrint()
'updateby Extendoffice
バリアントとしての薄暗いxEnd
バリアントとしての薄暗いxStart
Dim xScreen をブール値として
薄暗い私は長く
エラーで次の再開
LInput:
xStart = Application.InputBox( "最初の数字を入力してください:"、 "Kutools forExcel")
xEnd = Application.InputBox( "最後の番号を入力してください:"、 "Kutools forExcel")
TypeName(xCount)= "Boolean"の場合、Subを終了します
If(xStart = "")Or(Not IsNumeric(xStart))Or(xStart <1)Then
MsgBox「エラーが入力されました。もう一度入力してください」、vbInformation、「KutoolsforExcel」
GoTo LInput

xScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
I = xStartToxEndの場合
I Mod 2=0の場合
ActiveSheet.Range( "A1")。Value = "Company-00"&I + 1
ActiveSheet.Range( "A20")。Value = "Company-00"&I

ActiveSheet.Range( "A20")。Value = "Company-00"&I + 1
ActiveSheet.Range( "A1")。Value = "Company-00"&I
ActiveSheet.PrintOut
終了する場合
次へ
ActiveSheet.Range( "A1")。ClearContents
ActiveSheet.Range( "A20")。ClearContents
Application.ScreenUpdating = xScreen
終了する場合
End Subの

-------------------------------------------------- -------------------------------------------------- -----ありがとう、RNS
このコメントは、サイトのモデレーターによって最小化されました
私のセルはI3で、試してみると番号は2298です(VBAコード:各印刷後にセル値を自動インクリメントします:)それは私に22981を与えますどうすれば2298,2299,2300にそれを得ることができますか
このコメントは、サイトのモデレーターによって最小化されました
こんにちは、ジェニファー、
問題に対処するには、次のVBAコードを適用してください。
注:プレフィックスのテキストと番号を自分のものに変更してください。

Sub IncrementPrint_Num()
バリアントとしての薄暗いxCount
Dim xScreen をブール値として
薄暗い私は長く
文字列としての薄暗いxStr
Dim xInt As Integer
エラーで次の再開
xStr ="Company-"'プレフィックステキスト
xInt =2291'番号
LInput:
xCount = Application.InputBox( "印刷する部数を入力してください:"、 "Kutools forExcel")
TypeName(xCount)= "Boolean"の場合、Subを終了します
If(xCount = "")Or(Not IsNumeric(xCount))Or(xCount <1)Then
MsgBox「エラーが入力されました。もう一度入力してください」、vbInformation、「KutoolsforExcel」
GoTo LInput

xScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
I=1からxCountの場合
xInt = xInt + 1
ActiveSheet.Range( "A1")。Value = xStr&xInt
ActiveSheet.PrintOut
次へ
ActiveSheet.Range( "A1")。ClearContents
Application.ScreenUpdating = xScreen
終了する場合
End Subの

それを試してみてください、それがあなたを助けることができることを願っています!
このコメントは、サイトのモデレーターによって最小化されました
こんにちは、これを手伝ってくれませんか? xINTを5桁以上にしたい。 6桁の数字を入れるたびに、カウントは1に戻ります。どうすればそれを防ぐことができますか?
このコメントは、サイトのモデレーターによって最小化されました
こんにちは、私が見つけられなかった別の解決策を探していて、コードをカスタマイズしようとしてもこれまで達成できなかったにもかかわらず、非常に興味深いです。あなたの例に従って、同じページを100回印刷する必要があります。たとえば、同じPDFに、各ページでページ番号が増加しました。私が言ったように、照合方法を試しましたが、同じ印刷物の複数のコピーが必要な場合は、一緒に印刷することができます。よろしくお願いします。ジュゼッペ
このコメントは、サイトのモデレーターによって最小化されました
こんにちは、このコードはうまく機能していますが、32767セル値の後、再び1に戻ります。この値の後、番号1から出力されます。
このコメントは、サイトのモデレーターによって最小化されました
どうもありがとうございました、それは私のために働きます。 そして、私は自分のニーズに合うようにいくつかの小さな変更を加えることができます。 あなたの共有に本当に感謝します。
このコメントは、サイトのモデレーターによって最小化されました
こんにちはジェニファー、これを試してみてください
Sub IncrementPrint()
'updateby Extendoffice 20160530
バリアントとしての薄暗いxCount
Dim xScreen をブール値として
薄暗い私は長く
エラーで次の再開
LInput:
xCount = Application.InputBox( "印刷する部数を入力してください:"、 "Kutools forExcel")
TypeName(xCount)= "Boolean"の場合、Subを終了します
If(xCount = "")Or(Not IsNumeric(xCount))Or(xCount <1)Then
MsgBox「エラーが入力されました。もう一度入力してください」、vbInformation、「KutoolsforExcel」
GoTo LInput

xScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
I=1からxCountの場合

ActiveSheet.PrintOut
ActiveSheet.Range( "J18")。Value = ActiveSheet.Range( "J18")。Value + 1
次へ
'ActiveSheet.Range( "J18")。ClearContents'

Application.ScreenUpdating = xScreen
終了する場合
End Subの
このコメントは、サイトのモデレーターによって最小化されました
万人に感謝
このコメントは、サイトのモデレーターによって最小化されました
インクリメンタル#の印刷に適しています。 必要に応じて、5、10ごとに印刷するにはどうすればよいですか?
このコメントは、サイトのモデレーターによって最小化されました
印刷する値を選択する方法はありますか? たとえば、シーケンス1〜30を印刷しましたが、シーケンス15〜19を再度印刷する必要があります。
このコメントは、サイトのモデレーターによって最小化されました
印刷後のK11セル番号を1-2-3-4-5-6などに変更したいのですが。 また、その関数を呼び出す方法を教えてくださいpls help
このコメントは、サイトのモデレーターによって最小化されました
1 of 10、2 of 10、3of10などを印刷するように小さな変更を加える方法を考えていました。
そうでなければ、これはうまくいきます。 ありがとう。
このコメントは、サイトのモデレーターによって最小化されました
こんにちは、私の名前は確かです。私は、シリアル番号のないExcel形式のデータを持っています。これは、運送状の例のようです。 私はそれを100ページの印刷と見なす必要があり、必要なシリアル番号を4桁から印刷する必要がありますが、印刷中は手動で行う必要があります。 誰を印刷するかを説明できますか?印刷中にシリアル番号コードを自動生成します
このコメントは、サイトのモデレーターによって最小化されました
素晴らしい !! 私はプログラマーではありませんが、セル参照と必要な一意の番号を変更することができました。 私のために素晴らしい働きをしました神はあなたを祝福します!
このコメントは、サイトのモデレーターによって最小化されました
このコードに追加して、2部が自動的に印刷されるようにすることもできますか?
このコメントは、サイトのモデレーターによって最小化されました
この部分を変更できると思います:ActiveSheet.Range( "A1")。Value = "Company-00"&I
ActiveSheet.PrintOut

〜へ
ActiveSheet.Range( "A1")。Value = "Company-00"&I
ActiveSheet.PrintOut
ActiveSheet.PrintOut

それぞれのコピーを2つ取得します。
このコメントは、サイトのモデレーターによって最小化されました
再度開いた後、ファイルをそのまま印刷しても、連続番号が続くのではないかと思いました。
私が現在行っているのは、ファイルを開くたびに、ALT + F11、次にF5を押して、コピー数を示すことです。 次に、正しい番号でファイルを印刷してから、もう一度保存します。 再開するときは、同じ手順を実行するだけです。
ファイルを開くたびにそのまま印刷できるコードがあり、それでも連番が続く場合はどうでしょうか。
前もって感謝します
このコメントは、サイトのモデレーターによって最小化されました
再度開いた後、ファイルをそのまま印刷しても、連続番号が続くのではないかと思いました。

私が現在行っているのは、ファイルを開くたびに、ALT + F11、次にF5を押して、コピー数を示すことです。 次に、正しい番号でファイルを印刷してから、もう一度保存します。 再開するときは、同じ手順を実行するだけです。

ファイルを開くたびにそのまま印刷できるコードがあり、それでも連番が続く場合はどうでしょうか。

前もって感謝します
このコメントは、サイトのモデレーターによって最小化されました
上記のコードを共有していただきありがとうございます。 それは誰にとっても非常に役に立ちます。 印刷後に8ではなく1の数字を増やすために、さらにコードを追加できますか?返信を待っています。 ありがとう
ここにはまだコメントが投稿されていません
もっと読む
あなたのコメントを残す
ゲストとして投稿
×
この投稿を評価:
0   文字
推奨される場所

フォローする

著作権©の2009 - WWW。extendoffice.com。 | | 全著作権所有。 搭載 ExtendOffice。 | サイトマップ
MicrosoftおよびOfficeのロゴは、米国MicrosoftCorporationの米国およびその他の国における商標または登録商標です。
SectigoSSLで保護