【Excel VBA】既存の表からユニーク値分だけ行追加(分かりにくくてすみません)

Excel VBAで、
以下の範囲で5つの項目をうまく操作したいです。
1行目が項目名です。
A列「連番」：2行目からカウント
E列「年月」：「2021年04月」が入っています
F列「区分1」：01～29(29パターンありますが将来増減の可能性あり)
G列「区分2」：A～J(10パターン)
H列「比率」：ある率が入ってます(値は本件と無関係です)

これが以下の様に全組み合わせに対する率が列挙されています。

A列，E列，F列，G列，H列（B～D列は別の情報が入っていて無視してOK）
1，2021年04月，01，A，任意の率
2，2021年04月，01，B，任意の率
・
・
9，2021年04月，01，I，任意の率
10，2021年04月，01，J，任意の率
11，2021年04月，02，A，任意の率
12，2021年04月，02，B，任意の率
・
・
281，2022年04月，29，A，任意の率
282，2022年04月，29，B，任意の率
・
・
290，2022年04月，29，J，任意の率

つまり、AからJまで進んだら、01が02になり、、、の繰り返し、
29，Jまであるので、現在290行あります。
もし区分1が30まで増えたら全行数が300行になるという事になります。

前置きが長くなりましたが、上記は自動で生成されるようになっています。
----------
今回の相談は、その下に自動で追加したいのです。

E列「年月」、F列「区分1」の全パターンに、
G列には「全体」という固定値、
H列には「1」という数値を固定で入れて行追加したいのです。

具体的にはこうなると思います
291，2021年04月，01，全体，1
292，2021年04月，02，全体，1
・
・
319，2021年04月，29，全体，1

つまり今回の場合は290行目の下に29行追加されるのですが、
問題点は、
・区分1の増減により全体の行数が変わる
・A列が連番になっている必要がある

長くなってしまいましたが、問題点解決策のアドバイスをお願いいたします。

質問者からの補足コメント

• 

  2022年というのは誤入力です。失礼いたしました。
  1か月分だけです。
  29行だけ追加されることになりますがその特定方法が分からず。。。

  No.2の回答に寄せられた補足コメントです。 補足日時：2021/03/19 10:22

No.23 回答者： めぐみん_ 回答日時： 2021/03/19 18:38

一応No.22の個数については問題がないと仮定してですが。

Sub megu_test2()
Dim myDic As Object
Dim r As Range, rr As Range, n As Long

Set myDic = CreateObject("Scripting.Dictionary")
Set r = Range("A:A").SpecialCells(xlCellTypeFormulas, 1)
Set r = r.Cells(r.Rows.Count)

n = Int(r.Value / 10)

With r.Offset(1)

'--Ａ列に触れたくない時はこの間を削除して下さい--
With .Range("A1").Resize(n)
.Formula = "=Row()-1"
.Value = .Value
End With
'-------------------------------------------------

With .Range("E1").Resize(n)
r.Range("E1").Copy .Cells
End With

For Each rr In Range("F2", r.Range("F1"))

If myDic.Count = n Then Exit For
If Not myDic.Exists(rr.Value) Then myDic.Add rr.Value, ""

Next

With .Range("F1").Resize(n)
.Value = Application.Transpose(myDic.Keys)
End With

With .Range("G1").Resize(n)
.Value = "全体"
End With

With .Range("H1").Resize(n)
.Value = 1
End With

End With

Set myDic = Nothing
Set r = Nothing

End Sub

この回答へのお礼

>一応No.22の個数については問題がないと仮定してですが。

No.22のお礼の通り変動します。
返信が遅かったばかりに余計な手間を取らせて申し訳ありません。

今、自力で読み解こうとしてますが難しいです。すごいですね。

お礼日時：2021/03/19 21:06

No.22 回答者： めぐみん_ 回答日時： 2021/03/19 17:58

No.21のお礼について。

今回の質問で言えばＦ列に追加されるデータ数は２９個ですよね？
で、実際追加前のデータは重複なしで２９個以上は必ずあるのでしょうか？
そしてデータ数の増減の際にもそれは守られる物なのでしょうか？

この回答へのお礼

ありがとうございます！
最初の質問にて以下の様に書いてます。
>もし区分1が30まで増えたら全行数が300行になるという事になります。
>
>問題点は、
>・区分1の増減により全体の行数が変わる

29以下に減る可能性もあり、増える可能性もあります。

データ数は、区分1(現在29パターン)と区分2(10パターン)の全組合せなので
現在は29×10＝290行存在します。
区分1が30に増えた場合は、30×10＝300行になるため、
301行目から
区分1の重複無しユニーク値　全体　1
となります。

お礼日時：2021/03/19 20:57

No.21 回答者： めぐみん_ 回答日時： 2021/03/19 17:22

＞F2以降のユニーク値を転記したいんです。

ですので一体どこから取得するのか？と。
Ｂｏｏｋを開いてこの質問をされている質問者さんは何も不思議に感じないかもですが、Ｓｈｅｅｔ構成さえ不明な回答者には『閉じた本の感想文を書け』と言われているようなものです。

なのでどこからどのような条件で取得するのかを箇条書きにせよＢｏｏｋを見ていなくてもわかるように情報を流してください。
それに画像があればなおよいですけど。

この回答へのお礼

すみません。
何度もありがとうございます。

例えば、A～H列に以下の様な情報が入っていたとして、
A列　F列　G列　H列
1　発送作業　A　2
2　発送作業　B　3
3　WEB構築作業　A　2
4　集計作業　A　2
5　集計作業　B　5
6　集計作業　C　4

最下部以降に以下の値を書き出したいのです。
「F列の重複を無くしてユニーク値」という方が分かりやすいでしょうか。
(「全体」と「1」は固定値です。)

291　発送作業　全体　1
292　WEB構築作業　全体　1
293　集計作業　全体　1
・
・

分かりづらければ画像を作ります。

お礼日時：2021/03/19 17:35

No.20 回答者： めぐみん_ 回答日時： 2021/03/19 15:54

Ｆ列の部分を以下に変えてみたらどうなりますか？

With .Range("F1").Resize(n)
.Value = Range("F2").Resize(n).Value
End With

⇒Range("F2") の前にはピリオド(.)は不要ですから。

この回答へのお礼

何度もありがとうございます。

F列部分だけ変えてみたところ、
F列の文字情報が追加されるようになったのですが、
F2からF30の範囲がF292以降にそのまま転記される結果となりました。
F2以降のユニーク値を転記したいんです。

お礼日時：2021/03/19 16:21

No.19 回答者： めぐみん_ 回答日時： 2021/03/19 15:29

No.18です。

一点違っているって言われてもここまでそのような情報ありましたっけ？
まず正確に画像として（ダミーでも）見てみたいのと、ユニーク値の列挙ってどこから得るのかもわからない。

正直ダミーデータでもBookを直接見られるか、先のように以前の製作者に頼むべきか業務委託の方が普通は良いと思う位、何か色々変わってくるから大変。

Ｆ列に案件名ってＦ列は数字？ではなかったと言う事ですよね？
何故にそんな遠回りな作業をさせているのかが不思議です。

この回答へのお礼

すみません。
No.10 のお礼のところで↓このように書かせていただいてはいたのですが

>F列は文字列です。
>実際には様々な案件名が入ってますが、伏せるためと
>またカウントしやすいように"01"の表記にしてます。

ほんと申し訳ありません。

お礼日時：2021/03/19 16:14

No.18 回答者： めぐみん_ 回答日時： 2021/03/19 13:46

Ａ列に存在するかもしれない数式を連番に変えても良ければ、

Sub megu_test()
Dim r As Range, n As Long

Set r = Range("A:A").SpecialCells(xlCellTypeFormulas, 1)
Set r = r.Cells(r.Rows.Count)

n = Int(r.Value / 10)

With r.Offset(1)

'--Ａ列に触れたくない時はこの間を削除して下さい--
With .Range("A1").Resize(n)
.Formula = "=Row()-1"
.Value = .Value
End With
'-------------------------------------------------

With .Range("E1").Resize(n)
r.Range("E1").Copy .Cells
End With

With .Range("F1").Resize(n)
.Formula = "=Row()-" & r.Row
.Value = .Value
.NumberFormat = "00"
End With

With .Range("G1").Resize(n)
.Value = "全体"
End With

With .Range("H1").Resize(n)
.Value = 1
End With

End With

Set r = Nothing

End Sub

この回答へのお礼

ありがとうございます！

>Ａ列に存在するかもしれない数式を連番に変えても良ければ、

はい。全ての列に関数が入ってましたが、A列も含め値を上書きしちゃって良いんです。その後、別名保存して閉じちゃいますからこのシートの数式はその後も残る想定です。

そして、頂いたソースを実行してみたら非常に完成に近づきました。
一点違ってるのは、01、02・・・と固定値が入ってしまう点です。
F列には実際には様々な案件名が入っていて、ユニーク値を列挙したいのです。

例えば、F列に
1　発送作業　A　2
2　発送作業　B　3
3　WEB構築作業　A　2
4　集計作業　A　2
5　集計作業　B　5
6　集計作業　C　4

が入っていたとしたら、以下を最下部に値で行追加したいんです。

291　発送作業　全体　1
292　WEB構築作業　全体　1
293　集計作業　全体　1
・
・
こちらの伝え方が拙くて申し訳ありません。

お礼日時：2021/03/19 15:15

No.17 回答者： Qchan1962 回答日時： 2021/03/19 13:25

＃８のお礼欄について

頓珍漢な回答を重ねてしまい申し訳ないです。
だいぶ熟しているので今更、理解の浅い私は回答しずらいのですが、

＞今回の相談は、その下に自動で追加したいのです。
必ず（数式でない）値の入る列はどこでしょう？
その列が無いのであれば、＃12様、＃13様のように取得するのが良いと思います。

また、新規行を取得できれば、新しいデータを書き込むのは出来ますでしょうか、新規データを取得したとして、、必ず（数式でない）値の入る列がE列である場合、下記でF列の配番が出来ると思います。

Sub aa()
Dim i As Long
Dim srtRow As Long, endRow As Long
Dim n As Integer, no As String
srtRow = Cells(Rows.Count, "E").End(xlUp).Row + 1

'新規データ追加
'cells(srtRow,??)~~??

endRow = Cells(Rows.Count, "E").End(xlUp).Row
'F列
For i = srtRow To endRow
n = n + 1
If n <= 9 Then
no = "'0" & n
Else
no = "'" & n
End If
Cells(i, "F").Value = no
Next
'A列連番
With Range("A" & srtRow & ":A" & endRow)
.Formula = "=row()" & -1
.Value = .Value
End With
End Sub

旧データと新規データの差異（行数）を求めてその間の行に出力するのが良さそうです。

この回答へのお礼

ありがとうございます。
現在No.18さんの回答が求めてたものに近いです。
自力でも試行錯誤してますが皆さんのスキルにはかないません^^;

お礼日時：2021/03/19 15:17

No.16 回答者： めぐみん_ 回答日時： 2021/03/19 12:58

No.13です。

そのコードでエラーにならないと言うのなら、連番もまた数式によってある条件が発生した時に番号が出るんじゃないですか？
例えばＢ列以降にデータが入力された時とか？
仮にそうならＡ列は弄る必要がないように思えますが。

コードの意味的には
・セルに入力されているのが数式である事
・セルの表示されているのが数値である事
なんですよね。
Ａ列の数式を解読してみては？
下手に後から数値を代入させて（数式を消して）問題になりませんかね？

この回答へのお礼

>連番もまた数式によってある条件

はい。別シートの「2020年4月」についてる連番が全て表示されるようになってます。
現在はたまたま、「2020年4月」も「2020年5月」もNo.290が最下行です。
No.290 以降も数式が入ってますが、上から値を書き込んでしまって構いません。

お礼日時：2021/03/19 15:20

No.15 回答者： tatsumaru77 回答日時： 2021/03/19 12:22

>つまり次は、292行目に291と値をセットしていけば良いんですね。

はい。そうです。
なにか不明点があれば、補足してください。

No.14 回答者： めぐみん_ 回答日時： 2021/03/19 11:33

No.12です。

もし関数ではなく値として存在しているのなら、

Sub megu_2()
Dim r As Range

Set r = Range("A:A").SpecialCells(xlCellTypeConstants, 1)

MsgBox "最終セルは、" & r.Cells(r.Rows.Count).Address(0, 0) & " です"

End Sub

こちらとか。

この回答へのお礼

これだと、「該当するセルが見つかりません」という実行時エラー1004
となりました。

お礼日時：2021/03/19 12:12