[[20191127100427]]　『VBA　任意の行数で値を入力する』（naki）　ページの最後に飛ぶ

『VBA　任意の行数で値を入力する』（naki）

VBAの構築についてご教授お願い致します。

Aの列に行ごとにデータがはいっています。

マクロ実行後
A列の値が同じものにはB列にA列の値を入力します。また、5の倍数ごとに末尾に"-連番"を入力します。

A列の値が切り替わる際、5の倍数ごとに空白の行を間に挟みたい。

実例を下記に記載致しました。

宜しくお願い致します。

【元データ】

 ｜A｜B｜
1｜1｜ ｜
2｜1｜ ｜
3｜1｜ ｜
4｜1｜ ｜
5｜1｜ ｜
6｜1｜ ｜
7｜1｜ ｜
8｜2｜ ｜
9｜2｜ ｜
0｜2｜ ｜
1｜3｜ ｜
2｜3｜ ｜
3｜3｜ ｜
4｜3｜ ｜
5｜3｜ ｜
6｜3｜ ｜
7｜3｜ ｜
8｜ ｜ ｜
9｜ ｜ ｜
0｜ ｜ ｜

【マクロ実行後】

 ｜A｜B  ｜
1｜1｜1-1｜
2｜1｜1-1｜
3｜1｜1-1｜
4｜1｜1-1｜
5｜1｜1-1｜
6｜1｜1-2｜
7｜1｜1-2｜
8｜ ｜   ｜
9｜ ｜   ｜
0｜ ｜   ｜
1｜2｜2-1｜
2｜2｜2-1｜
3｜2｜2-1｜
4｜ ｜　 ｜
5｜ ｜　 ｜
6｜3｜3-1｜
7｜3｜3-1｜
8｜3｜3-1｜
9｜3｜3-1｜
0｜3｜3-1｜
1｜3｜3-2｜
2｜3｜3-2｜
3｜3｜3-2｜
4｜3｜3-2｜
5｜3｜3-2｜
6｜ ｜　 ｜
7｜ ｜　 ｜
8｜ ｜　 ｜
9｜ ｜　 ｜
0｜ ｜　 ｜

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

 こんな感じですかね

 Sub Macro2()
    Dim myCurNO As Long
    Dim myCurSub As Long
    Dim i As Long
    Dim j As Long

    i = 0
    j = 0
    myCurNO = Cells(1, 1).Value
    myCurSub = 0
    Do
        i = i + 1
        If myCurNO = Cells(i, 1).Value Then
            j = j + 1
        Else
            Cells(i, 1).EntireRow.Insert
            i = i + 1
            j = j + 2
            myCurNO = Cells(i, 1).Value
            myCurSub = 0
        End If
        If myCurSub < 5 Then
            myCurSub = myCurSub + 1
        Else
            myCurSub = 1
        End If
        Cells(j, 2).Value = myCurNO & "-" & myCurSub
    Loop Until Len(Cells(i + 1, 1).Value) = 0
 End Sub

（渡辺ひかる） 2019/11/27(水) 11:56

 すみません　勘違いしていました　前回のはボツです
 下記を試してください

 Sub Macro2()
    Dim myCurNO As Long
    Dim myCurSubCnt As Long
    Dim myCurSub As Long
    Dim i As Long
    Dim j As Long

    i = 0
    j = 0
    myCurNO = Cells(1, 1).Value
    myCurSub = 1
    Do
        i = i + 1
        If myCurNO = Cells(i, 1).Value Then
            j = j + 1
        Else
            Cells(i, 1).EntireRow.Insert
            i = i + 1
            j = j + 2
            myCurNO = Cells(i, 1).Value
            myCurSubCnt = 0
            myCurSub = 1
        End If
        If myCurSubCnt < 5 Then
            myCurSubCnt = myCurSubCnt + 1
        Else
            myCurSubCnt = 0
            myCurSub = myCurSub + 1
        End If
        Cells(j, 2).Value = myCurNO & "-" & myCurSub
    Loop Until Len(Cells(i + 1, 1).Value) = 0
 End Sub

（渡辺ひかる） 2019/11/27(水) 12:18

＞渡辺ひかる　様

すいません、状況が変わりまして再度相談させて頂きたく存じます。

【変更前】A列の値が切り替わる際、5の倍数ごとに空白の行を間に挟みたい。

↓

【変更後】B列の値が切り替わる際、継ぎ目の行数が5の倍数になるよう空白の行を挿入したい。

【元データ】

 ｜A｜B｜
1｜1｜ ｜
2｜1｜ ｜
3｜1｜ ｜
4｜1｜ ｜
5｜1｜ ｜
6｜1｜ ｜
7｜1｜ ｜
8｜2｜ ｜
9｜2｜ ｜
0｜2｜ ｜
1｜3｜ ｜
2｜3｜ ｜
3｜3｜ ｜
4｜3｜ ｜
5｜3｜ ｜
6｜3｜ ｜
7｜3｜ ｜
8｜3｜ ｜
9｜3｜ ｜
0｜3｜ ｜

【マクロ実行後】

 ｜A｜B  ｜
1｜1｜1-1｜
2｜1｜1-1｜
3｜1｜1-1｜
4｜1｜1-1｜
5｜1｜1-1｜
6｜1｜1-2｜
7｜1｜1-2｜
8｜ ｜   ｜
9｜ ｜   ｜
0｜ ｜   ｜
1｜2｜2-1｜
2｜2｜2-1｜
3｜2｜2-1｜
4｜ ｜　 ｜
5｜ ｜　 ｜
6｜3｜3-1｜
7｜3｜3-1｜
8｜3｜3-1｜
9｜ ｜　 ｜
0｜ ｜　 ｜
1｜3｜3-2｜
2｜3｜3-2｜
3｜3｜3-2｜
4｜3｜3-2｜
5｜ ｜　 ｜
6｜3｜3-3｜
7｜3｜3-3｜
8｜3｜3-3｜
9｜ ｜　 ｜
0｜ ｜　 ｜
（naki） 2019/11/27(水) 14:52

 ＞すいません、状況が変わりまして再度相談させて頂きたく存じます。

 状況が変わるのは勝手ですけど、私が回答したコードはどうだったのでしょうか？
 使えないからスルーですか？

 それと、変更後の　3の枝番付加のルールがわかりません。

（渡辺ひかる） 2019/11/27(水) 15:05

＞渡辺ひかる　様

失礼致しました。

掲示板に記載の内容と同様の環境で実行させて頂いたところ、
以下のような結果となっており

A列の値が切り替わる際に1行のみ改行がはいっておりました。

https://gyazo.com/f829ad57dc9aa66ba195b0b257d71976

実行結果としては近いものになっておりましたので、下記の指示を組み込めば実現できそうなのですが、中々うまくいきません。

B列の値が切り替わる際、値が入った行と空白行を含めた行数が5の倍数となるように空白行を挿入したいです。

3-1
3-1
3-1

この場合は、値の入った行と空白行の総数が5となるように、2行挿入

3-2
3-2
3-2
3-2

この場合は、値の入った行と空白行の総数が5となるように、1行挿入

3-3
3-3
3-3

この場合は、値の入った行と空白行の総数が5となるように、2行挿入

値の入った行数は6以上になる場合もございます。

（naki） 2019/11/27(水) 15:26

 ＞A列の値が切り替わる際に1行のみ改行がはいっておりました

 こちらの意図した通りには動いたということですね。

 ＞B列の値が切り替わる際、値が入った行と空白行を含めた行数が5の倍数となるように空白行を挿入したいです。

 空白行の挿入ルールはわかりますが、それ以前にB列の設定ルールがわかりません。
 A列で同じ数字が5個続いたら、B列をカウントアップするのではないのですか？
 （1の場合はそうなってますよね？）

（渡辺ひかる） 2019/11/27(水) 15:33

＞渡辺ひかる　様

説明が至らず申し訳ありません。

?@B列の値の入力はA列をカウント

?A空白行の挿入は?@実行後のB列をカウント

というイメージです。
（naki） 2019/11/27(水) 15:46

＞渡辺ひかる　様
説明が至らず申し訳ありません。
１.B列の値の入力はA列をカウント
２.空白行の挿入は"１．"実行後のB列をカウント
というイメージです。
（naki） 2019/11/27(水) 15:47

１．【元データ】

 ｜A｜B｜
1｜1｜ ｜
2｜1｜ ｜
3｜1｜ ｜
4｜1｜ ｜
5｜1｜ ｜
6｜1｜ ｜
7｜1｜ ｜
8｜2｜ ｜
9｜2｜ ｜
0｜2｜ ｜
1｜3｜ ｜
2｜3｜ ｜
3｜3｜ ｜
4｜3｜ ｜
5｜3｜ ｜
6｜3｜ ｜
7｜3｜ ｜
8｜3｜ ｜
9｜3｜ ｜
0｜3｜ ｜

２．【B列にデータ挿入】

 ｜A｜B｜
1｜1｜1-1｜
2｜1｜1-1｜
3｜1｜1-1｜
4｜1｜1-1｜
5｜1｜1-1｜　←　A列が同一の値に5データごとに連番付与
6｜1｜1-2｜
7｜1｜1-2｜
8｜2｜2-1｜
9｜2｜2-1｜
0｜2｜2-1｜
1｜3｜3-1｜
2｜3｜3-1｜
3｜3｜3-1｜
4｜3｜3-1｜
5｜3｜3-1｜
6｜3｜3-2｜
7｜3｜3-2｜
8｜3｜3-2｜
9｜3｜3-2｜
0｜3｜3-2｜

３．【空白行の挿入】

 ｜A｜B  ｜
1｜1｜1-1｜
2｜1｜1-1｜
3｜1｜1-1｜
4｜1｜1-1｜
5｜1｜1-1｜
6｜1｜1-2｜
7｜1｜1-2｜
8｜ ｜   ｜
9｜ ｜   ｜
0｜ ｜   ｜　←　B列同一の値が空白行含め5の倍数となるよう空白行を挿入
1｜2｜2-1｜
2｜2｜2-1｜
3｜2｜2-1｜
4｜ ｜　 ｜
5｜ ｜　 ｜
6｜3｜3-1｜
7｜3｜3-1｜
8｜3｜3-1｜
9｜ ｜　 ｜
0｜ ｜　 ｜
1｜3｜3-2｜
2｜3｜3-2｜
3｜3｜3-2｜
4｜3｜3-2｜
5｜ ｜　 ｜
6｜3｜3-3｜
7｜3｜3-3｜
8｜3｜3-3｜
9｜ ｜　 ｜
0｜ ｜　 ｜

（naki） 2019/11/27(水) 15:52

 ＞１.B列の値の入力はA列をカウント

 （naki） 2019/11/27(水) 14:52　のデータで　3-1以降の部分ですが

 マクロ実行前のデータのどこをどうカウントしたら、3-1、3-2、3-3　となるんですか？

 または

 ２．【B列にデータ挿入】 のデータ　と　３．【空白行の挿入】 でデータそのものが変わっているのですが・・・

（渡辺ひかる） 2019/11/27(水) 15:58

＞渡辺ひかる　様

すいません、データ一覧は記入ミスでした。

１．【元データ】

 ｜A｜B｜
1｜1｜ ｜
2｜1｜ ｜
3｜1｜ ｜
4｜1｜ ｜
5｜1｜ ｜
6｜1｜ ｜
7｜1｜ ｜
8｜2｜ ｜
9｜2｜ ｜
0｜2｜ ｜
1｜3｜ ｜
2｜3｜ ｜
3｜3｜ ｜
4｜3｜ ｜
5｜3｜ ｜
6｜3｜ ｜
7｜3｜ ｜
8｜ ｜ ｜
9｜ ｜ ｜
0｜ ｜ ｜

２．【B列にデータ挿入】

 ｜A｜B　｜
1｜1｜1-1｜
2｜1｜1-1｜
3｜1｜1-1｜
4｜1｜1-1｜
5｜1｜1-1｜
6｜1｜1-2｜
7｜1｜1-2｜
8｜2｜2-1｜
9｜2｜2-1｜
0｜2｜2-1｜
1｜3｜3-1｜
2｜3｜3-1｜
3｜3｜3-1｜
4｜3｜3-1｜
5｜3｜3-1｜
6｜3｜3-2｜
7｜3｜3-2｜
8｜ ｜ 　｜
9｜ ｜ 　｜
0｜ ｜ 　｜

３．【空白行の挿入】

 ｜A｜B　｜
1｜1｜1-1｜
2｜1｜1-1｜
3｜1｜1-1｜
4｜1｜1-1｜
5｜1｜1-1｜
6｜1｜1-2｜
7｜1｜1-2｜
8｜ ｜ 　｜
9｜ ｜ 　｜
0｜ ｜ 　｜
1｜2｜2-1｜
2｜2｜2-1｜
3｜2｜2-1｜
4｜ ｜ 　｜
5｜ ｜ 　｜
6｜3｜3-1｜
7｜3｜3-1｜
8｜3｜3-1｜
9｜3｜3-1｜
0｜3｜3-1｜
1｜3｜3-2｜
2｜3｜3-2｜
3｜ ｜ 　｜
4｜ ｜ 　｜
5｜ ｜ 　｜

（naki） 2019/11/27(水) 16:10

２．【B列にデータ挿入】

3の値が縦に7つ並んでいるので、5行ごとに連番を付与

A列：3　→　B列：3-1
A列：3　→　B列：3-1
A列：3　→　B列：3-1
A列：3　→　B列：3-1
A列：3　→　B列：3-1
A列：3　→　B列：3-2
A列：3　→　B列：3-2

（naki） 2019/11/27(水) 16:17

 ＞すいません、データ一覧は記入ミスでした。

 （渡辺ひかる） 2019/11/27(水) 15:05　の時点からずっとそのことを指摘しているのに・・・

（渡辺ひかる） 2019/11/27(水) 16:18

＞渡辺ひかる　様

確認不足でお手間取らせてしまい申し訳ないです；；
（naki） 2019/11/27(水) 16:23

 Sub Macro2()
    Dim myCurNO As Long
    Dim myCurSubCnt As Long
    Dim myCurSub As Long
    Dim myCurStr As String
    Dim myMod As Long
    Dim i As Long

    i = 0
    myCurNO = Cells(1, 1).Value
    myCurSub = 1
    Do
        i = i + 1
        If myCurNO <> Cells(i, 1).Value Then
            myCurNO = Cells(i, 1).Value
            myCurSubCnt = 0
            myCurSub = 1
        End If
        If myCurSubCnt < 5 Then
            myCurSubCnt = myCurSubCnt + 1
        Else
            myCurSubCnt = 0
            myCurSub = myCurSub + 1
        End If
        Cells(i, 2).Value = myCurNO & "-" & myCurSub
    Loop Until Len(Cells(i + 1, 1).Value) = 0

    i = 1
    myCurStr = Cells(1, 2).Value

    Do
        i = i + 1
        If myCurStr <> Cells(i, 2).Value Then
           myCurStr = Cells(i, 2).Value
           myMod = (i - 1) Mod 5
           If myMod > 0 Then
            Cells(i, 2).Resize(5 - myMod).EntireRow.Insert
            i = i + 5 - myMod
            End If
        End If
    Loop Until Len(Cells(i + 1, 1).Value) = 0
 End Sub

（渡辺ひかる） 2019/11/27(水) 16:30

＞渡辺ひかる　様

希望通りに動作致しました。

途中ぐだぐだになってしまって申し訳ございませんでした

長らくお付き合い頂きありがとうございました！
（naki） 2019/11/27(水) 16:50

＞渡辺ひかる　様

データ数を増やして実行してみたところ、キャプチャーの通り、連番付与の数が一致していないようです。

1　までは正常に動作

2　以降が連番数が6以上になっているようです。

改行につきましては、連番で判定しているので、うまく動作しているか不明です。

【実行後のキャプチャー】
https://gyazo.com/f7ee826b750a76ba4135ea8ed15fa3e4
（naki） 2019/11/27(水) 17:22

 衝突!

 A列の同一番号行が 5 の倍数の場合は行の挿入は無しですよね？

 単純に

 Sub test()
     Dim x, n As Long, i As Long
     x = Range("a" & Rows.Count).End(xlUp).Row
     x = Filter(Evaluate("transpose(if(row(1:" & x & ")=1,0,if(a1:a" & x & _
             "<>a2:a" & x + 1 & ",row(1:" & x & "))))"), False, 0)
     For i = UBound(x) To 1 Step -1
         With Range("b" & x(i - 1) + 1 & ":b" & x(i))
             .Formula = "=a" & .Row & "&text(roundup(row(a1)/5,0),""-0"")"
         End With
         n = 5 - (x(i) - x(i - 1)) Mod 5
         If n < 5 Then Rows(x(i) + 1).Resize(n).Insert
     Next
 End Sub
（seiya） 2019/11/27(水) 17:25

＞seiya　様

ありがとうございます。

実行してみたところ基本的には正常に動作するようなのですが、データの量を増やすと一部連番付与に不備が生じます。

キャプチャー内　2-5、2-4　参照
https://gyazo.com/6ff6033ff205dc61dee8f44de725f66c
（naki） 2019/11/27(水) 17:41

＞seiya　様

複数回テストしてみているのですが、1、2回動作不備があったものの、ほぼ正常に動作しております。

正常に動作しなかったものは私の入力ミスの可能性もある為、様子をみようと思います。

ご回答ありがとうございました。
（naki） 2019/11/27(水) 17:48

 >キャプチャー内　2-5、2-4　参照
 そのような動きをすることは無いと思います。

 何らかの不具合が出た場合は、実際のファイルをアップしてもらえば解決できますが、
 図をアップされても解決のしようがありません。
（seiya） 2019/11/27(水) 18:01

＞seiya　様

かしこまりました。

次回からはアップローダー等にあげてからご相談させて頂きます。

コードの配列が難しいので、参照する列数の変更など調整箇所を教えて頂く事は可能でしょうか。

a列　→　aj列
b列　→　k列
1行目は項目
2行目からデータ

↓　わかりそうなところを範囲で差し替えてみたのですが、エラーがでました・・・

     Dim x, n As Long, i As Long
     x = Range("aj" & Rows.Count).End(xlUp).Row
     x = Filter(Evaluate("transpose(if(row(2:" & x & ")=1,0,if(aj2:aj" & x & _
             "<>aj3:aj" & x + 1 & ",row(2:" & x & "))))"), False, 0)
     For i = UBound(x) To 1 Step -1
         With Range("k" & x(i - 1) + 1 & ":k" & x(i))
             .Formula = "=aj" & .Row & "&text(roundup(row(aj2)/5,0),""-0"")"
         End With
         n = 5 - (x(i) - x(i - 1)) Mod 5
         If n < 5 Then Rows(x(i) + 1).Resize(n).Insert
（naki） 2019/11/27(水) 18:13

 ここ
 if(row(2:" & x & ")=1,0
 ↓
 if(row(2:" & x & ")=2,1

      x = Filter(Evaluate("transpose(if(row(2:" & x & ")=2,1,if(aj2:aj" & x & _
             "<>aj3:aj" & x + 1 & ",row(2:" & x & "))))"), False, 0)
（seiya） 2019/11/27(水) 18:26

＞seiya　様

ありがとうございます　修正します

エラーが生じるのですが余計なところ編集してしまってますかね・・・

コンパイルエラー
Forに対するNextがありません。

     Dim x, n As Long, i As Long
     x = Range("aj" & Rows.Count).End(xlUp).Row
     x = Filter(Evaluate("transpose(if(row(2:" & x & ")=2,1,if(aj2:aj" & x & _
             "<>aj3:aj" & x + 1 & ",row(2:" & x & "))))"), False, 0)
     For i = UBound(x) To 1 Step -1
         With Range("k" & x(i - 1) + 1 & ":k" & x(i))
             .Formula = "=aj" & .Row & "&text(roundup(row(aj2)/5,0),""-0"")"
         End With
         n = 5 - (x(i) - x(i - 1)) Mod 5
         If n < 5 Then Rows(x(i) + 1).Resize(n).Insert
（naki） 2019/11/27(水) 18:46

 それが全てなら、間違いなくコンパイルしないでしょう。
 なぜ、一部分のコードを提示するのでしょう？
（seiya） 2019/11/27(水) 18:52

 ＞データ数を増やして実行してみたところ、キャプチャーの通り、連番付与の数が一致していないようです。

 検証不足でした
 一か所だけ修正しました

 Sub Macro2()
    Dim myCurNO As Long
    Dim myCurSubCnt As Long
    Dim myCurSub As Long
    Dim myCurStr As String
    Dim myMod As Long
    Dim i As Long

    i = 0
    myCurNO = Cells(1, 1).Value
    myCurSub = 1
    Do
        i = i + 1
        If myCurNO <> Cells(i, 1).Value Then
            myCurNO = Cells(i, 1).Value
            myCurSubCnt = 0
            myCurSub = 1
        End If
        If myCurSubCnt < 5 Then
            myCurSubCnt = myCurSubCnt + 1
        Else
            myCurSubCnt = 1 '今回変更
            myCurSub = myCurSub + 1
        End If
        Cells(i, 2).Value = myCurNO & "-" & myCurSub
    Loop Until Len(Cells(i + 1, 1).Value) = 0

    i = 1
    myCurStr = Cells(1, 2).Value

    Do
        i = i + 1
        If myCurStr <> Cells(i, 2).Value Then
           myCurStr = Cells(i, 2).Value
           myMod = (i - 1) Mod 5
           If myMod > 0 Then
            Cells(i, 2).Resize(5 - myMod).EntireRow.Insert
            i = i + 5 - myMod
            End If
        End If
    Loop Until Len(Cells(i + 1, 1).Value) = 0
 End Sub

（渡辺ひかる） 2019/11/28(木) 09:01

＞seiya
＞渡辺ひかる

頂いたコードを調整することで希望の動作を実現させることができました。

長々とご相談にのって頂きありがとうございました。
（naki） 2019/11/29(金) 11:22

コメント返信：

[ 一覧(最新更新順) ]

[[20191127100427]] 『VBA 任意の行数で値を入力する』（naki） ページの最後に飛ぶ

[[20191127100427]]　『VBA　任意の行数で値を入力する』（naki）　ページの最後に飛ぶ