MENU

追加した重複データに、つづきの連番をつける

エクセルVBAマクロを、簡単に作成してみませんか?

例として、アプリで「追加した重複データに、つづきの連番をつける」VBAマクロを作成します。

処理のイメージ

事例

連番が入っていない黄色のセルに、連番を付けます。

マクロを実行すると、重複データに、つづきの連番がつきました。

並べ替えて、確認します。

できました(^^)/

アプリの設定

アプリの設定です。

トップページ ⇒▼連続データ・重複データ・連番 ⇒【ツール】重複データに連番をつける

※ セルの範囲は、重複データがある範囲と、その一つ右の列です。

※ その範囲の、左上セルと右下セルを指定してください。

表示されるVBAコード 

アプリで作成されたコードを、VBE画面に貼り付ければ、マクロの完成です。

Sub デモ_47() '追加した重複データに、つづきの連番をつける
Application.ScreenUpdating = False ' 画面描画を停止
Application.DisplayAlerts = False  ' 警告表示を停止
Dim セル範囲 As String, セル As Range, 右下セル As String
Sheets("sheet1").Select
セル範囲 = "b2:c13"
Dim 最大値辞書 As Object, 表 As Variant, キー As Variant, 配列 As Variant, 行 As Long
Set 最大値辞書 = CreateObject("Scripting.Dictionary")
'表(配列)に、セル範囲の値を取り込む
表 = Range(セル範囲).Value
For 行 = LBound(表) To UBound(表)
    'キーに1列目の値
    キー = 表(行, 1)
    '最大値辞書にキーが無いときは、
    If 最大値辞書.Exists(キー) = False Then
        '配列を、行と2列目の値で作成し、
        配列 = Array(行, 表(行, 2))
        '最大値辞書に、そのキーと配列を加える
        最大値辞書.Add キー, 配列
    'キーがあるときは
    Else
        '配列に、そのキーの最大値辞書の配列を戻す
        配列 = 最大値辞書.item(キー)
        '表の2列目が、配列の2列目の値より大きいとき、
        If 表(行, 2) > 配列(1) Then
            '配列に、行と2列目の値をいれる
            配列(0) = 行
            配列(1) = 表(行, 2)
            'キーのアイテムを、その配列で上書き
            最大値辞書.item(キー) = 配列
        End If
    End If
Next 行
行 = 0
For 行 = LBound(表) To UBound(表)
    '2列目が空白のとき、
    If 表(行, 2) = "" Then
        'キーに1列目の値をいれる
        キー = 表(行, 1)
        '配列に、そのキーの最大値辞書の配列を戻す
        配列 = 最大値辞書.item(キー)
        '最大値に1を加算
        配列(1) = 配列(1) + 1
        'セルに、その最大値を入力
        Range("b2").Cells(行, 2).Value = 配列(1)
        'その配列で、キーのアイテムを上書き
        最大値辞書.item(キー) = 配列
    End If
Next 行
Application.DisplayAlerts = True   ' 警告表示を再開
Application.ScreenUpdating = True  ' 画面描画を再開
End Sub

マクロを使うメリット

手作業で数分かかる作業が、1秒で終わります。

ぜひ、アプリをご利用ください。

 

アプリはこちらから↓↓↓↓