質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

3回答

1521閲覧

VBAで、別列に記載の項目ごとの連番を振りたい

amatsuno

総合スコア54

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2021/12/28 04:35

#VBA(Excel)で、別列に記載の項目ごとに連番を振りたい

##目的:Excelの同一シート上で、A列で同一のものがある場合、B列に連番を付与させたい

###詳細
Excelのシート「dataA」に以下記載があります
(最上段は列名)

####元
AAA , BBB , CCC , DDD
OK1 , (null) , TEST11 , JP
OK1 , (null) , TEST22 , UN
OK1 , (null) , TEST33 , CN
OK2 , (null) , TEST44 , IK
OK2 , (null) , TEST55 , FR
OK3 , (null) , TEST66 , GM
OK3 , (null) , TEST77 , TR
OK3 , (null) , TEST88 , NC
OK4 , (null) , TEST99 , EG

ここで、
「AAA列が同じ値の際にBBB列に連番を付与したい」と思っています
AAA列はソート済みの状態です

####狙っている結果
AAA , BBB , CCC , DDD
OK1 , 1 , TEST11 , JP
OK1 , 2 , TEST22 , UN
OK1 , 3 , TEST33 , CN
OK2 , 1 , TEST44 , IK
OK2 , 2 , TEST55 , FR
OK3 , 1 , TEST66 , GM
OK3 , 2 , TEST77 , TR
OK3 , 3 , TEST88 , NC
OK4 , 1 , TEST99 , EG

###ここまで
連番を入れる方法は以下で可能と思われるのですが、
ここから先、どのように作成すればよいか、お分かりになられる方、
ご教授願えませんでしょうか

Dim i, STG, SYN STG = 2 STN = 1 For i = STG To Cells(Rows.Count, 2).End(xlUp).Row Cells(i, 2).Value = STN STN = STN + 1 Next

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答3

0

B2セルに以下のセル関数を入力して必要な範囲にコピー

=COUNTIF(A$2:A2,A2)

VBAで同じことを実現するなら

vb

1Sub Macro1() 2 With Range(Range("B2"), Cells(Cells(Rows.Count, 1).End(xlUp).Row, "B")) 3 .FormulaR1C1 = "=COUNTIF(R2C[-1]:RC[-1],RC[-1])" 4 .Value = .Value '数式を値に変換 5 End With 6End Sub

投稿2021/12/28 05:52

編集2021/12/28 22:03
takanaweb5

総合スコア354

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

amatsuno

2021/12/29 01:17

ありがとうございます。
guest

0

ベストアンサー

あなたのコードをできるだけ生かすようにしました。

VBA

1Option Explicit 2Public Sub 連番を振る() 3 Dim i, STG, STN, PREV 4 STG = 2 5 STN = 1 6 PREV = "" 7 For i = STG To Cells(Rows.Count, 1).End(xlUp).Row 8 If Cells(i, 1).Value <> PREV Then 9 STN = 1 10 End If 11 Cells(i, 2).Value = STN 12 STN = STN + 1 13 PREV = Cells(i, 1).Value 14 Next 15End Sub 16

投稿2021/12/28 05:09

tatsu99

総合スコア5424

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

amatsuno

2021/12/29 01:17

ありがとうございます。 ご記載のコードで実現できました
guest

0

こういうやり方ではどうでしょう

VBA

1 Dim i As Long, STG As Long 2 Dim key As String 3 Dim dicT As Object 4 5 STG = 2 6 7 Set dicT = CreateObject("Scripting.Dictionary") 8 9 For i = STG To Cells(Rows.count, "A").End(xlUp).row 10 key = Cells(i, "A").Value 11 12 If dicT.Exists(key) = False Then 13 dicT.Add key, 1 14 Else 15 dicT(key) = dicT(key) + 1 16 End If 17 18 Cells(i, "B").Value = dicT(key) 19 Next

投稿2021/12/28 05:01

bebebe_

総合スコア497

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

amatsuno

2021/12/29 01:17

ありがとうございます。 この部分で他にも入れる処理がありますので、参考とさせていただきます
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問