【ノーコード】1分でExcelを自動化する無料ツール

コードの知識不要😊ChatGPTしようぜ⚾17

MENU

【ノーコードVBA】重複データに連番をつける

エクセルVBAマクロを自動作成する無料アプリです。

例として「重複データに連番をつける」VBAマクロを作成します。

(ページの末尾に、VBAコード掲載)

事例 重複しているデータに、連番を付ける

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

できました(^^)/

アプリの設定

アプリのトップページ

 ⇒▼連続データ・重複データ・連番

 ⇒【ツール】重複データに連番をつける

 

【ポイント】

 重複を確認する列は、飛び飛びの列も指定できます。

 

 

表示されるVBAコード 

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

 

VBAコードを見る

Sub デモ() '重複データに連番をつける
 
Application.ScreenUpdating = False ' 画面描画を停止
Application.DisplayAlerts = False  ' 警告表示を停止
Dim セル範囲 As String, セル As Range, 右下セル As String
Sheets("Sheet1").Select
'表の最終行を決定
Dim 最終行 As Long
最終行 = Cells(Rows.Count, Range("A2").Column).End(xlUp).Row
セル範囲 = "a2" & ":" & Cells(最終行, Range("d2").Column).Address(False, False) 
' Dictionaryオブジェクトを作成
Dim 辞書 As Object
Set 辞書 = CreateObject("Scripting.Dictionary")
Dim 行 As Range
For Each 行 In Range(セル範囲).Rows
    ' キーを作成
    Dim キー As Variant
    キー = 行.Cells(1, 1) & "|" & 行.Cells(1, 2) & "|" & 行.Cells(1, 3) & "|" & 行.Cells(1, 4)
    If 辞書.Exists(キー) Then
        ' キーが存在する場合、個数を増やす
        辞書(キー)("個数") = 辞書(キー)("個数") + 1
    Else
        ' キーが存在しない場合、"個数"、"連番"のアイテムでキーを追加
        Dim アイテム As Object
        Set アイテム = CreateObject("Scripting.Dictionary")
        アイテム.Add "個数", 1
        アイテム.Add "連番", 0
        辞書.Add キー, アイテム
    End If
Next 行
' アイテム"個数"が2以上のとき、アイテム"連番"に1を加算して表示
For Each 行 In Range(セル範囲).Rows
    キー = 行.Cells(1, 1) & "|" & 行.Cells(1, 2) & "|" & 行.Cells(1, 3) & "|" & 行.Cells(1, 4)
    If 辞書(キー)("個数") > 1 Then
            辞書(キー)("連番") = 辞書(キー)("連番") + 1
            Cells(行.Row, Range("e2").Column).Value = 辞書(キー)("連番")
    End If
Next 行
End Sub

 

ChatGPTで修正

あなたが自動化したい内容と事例が少し異なる場合は、無料で使えるマイクロソフトの「BingAIチャット」でコードを修正します。とても簡単です!

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