VBAでの行数を揃える方法

質問

エクセルで下記のように氏名ごとに1行から複数行の行数が割り振られています。

　A 　　 　 B　　　 Ｃ
氏名 　出発日　　到着日

1佐藤 　2/1 　　　　 2/4
2佐藤 　3/1 　 　　　3/3
3佐藤 　8/2 　　 　　 8/15
4小林 　5/3 　　 　　 5/4
5田中 　1/20 　　 　 1/25
6田中 　 1/26 　　　 1/28
7田中 　 2/4 　　　　 2/6
8田中 　 6/1 　　　　 6/30
9田中 　 11/20 　　　11/23
これらを３行には２７行挿入、１行には２９行を最後に挿入して必ずどこのかたまりも３０行にする方法はありますでしょうか？
お分かりになる方、ご回答よろしくお願いいたします。

回答No.5

ichhabehunger

おおっ！

#4の方の
＞元の日付の入ったデータはなくして、単に、名前だけのリストにします
この考え方、素晴らしいですね。
ただ、「日付の入ったデータ」をどこかに退避させておいて
後で復活するようにすれば完璧です。
この考え方、使えそうです。

なお、私の方はすでに私の考え方でコード作成に成功しています。

回答No.4

Wendy02

ご質問では、表そのものを壊してよいようですから、元の日付の入ったデータはなくして、単に、名前だけのリストにします。質問は、なるべく最初から詳しく正確にお願いします。特に、最初から熱心に書いくれた人が報われないのは、決して良いことではありません。

注意：消されたデータは元に戻りません。

'//
Sub Test1()
　Dim rng As Range
　Dim ar As Variant
　Dim i As Long, j As Long, k As Long
　'タイトル行があるかないか、区分け
　If Application.CountA(Range("A1:C1")) > 2 Then
　　 k = 2
　Else
　　 k = 1
　End If
　Set rng = Range(Cells(k, 1), Cells(Rows.Count, 1).End(xlUp)).Resize(, 3)
　ar = rng.Value
　Application.ScreenUpdating = False
　rng.EntireColumn.ClearContents
'　rng.EntireColumn.Clear ''書式も消してしまうなら、こちらにする
　For i = 1 To UBound(ar, 1)
　　If i = UBound(ar, 1) Then
　　　Cells(j * 30 + 1, 1).Resize(30).Value = ar(i, 1)
　　ElseIf ar(i, 1) <> ar(i + 1, 1) Then
　　　Cells(j * 30 + 1, 1).Resize(30).Value = ar(i, 1)
　　　j = j + 1
　　End If
　Next i
　Application.ScreenUpdating = True
　Set rng = Nothing
End Sub

回答No.3

ichhabehunger

あれ？　１行目にはタイトル「氏名」「出発日」「到着日」が入っていませんでしたか？

１行目にはできるだけタイトル行を入れましょう。そうするとフィルタオプションが使えます。

とりあえず１つの考え方を示します。

Sheet2を作業用シートとして使い、フィルタオプションで重複のない名前データを取り出します。
そして、COUNTIF関数を埋め込み、それぞれの名前がいくつあるかをカウントします。
これが（作業用のシートを使うことが）気に入らないならDictionaryオブジェクトを使ってそれぞれの名前をカウントします。（以下にここまでをコード化してあります。意味を理解してください。）
その後は、Sheet1に１列目を挿入して作業列を確保し、名前の同じグループに連番を振っていきます。
（例．「佐藤」は１、「小林」は２、のように）
次に、データの最終行の続きから３０に満たない数だけ、それぞれの番号を追加してゆきます。
最後に１列目で昇順ソートをかけます。
そして１列目を削除します。
以上でできあがるはずです。
マクロの記録をとってもらうと（記録できない操作もありそうだが）参考になるコードを得られます。

Option Explicit
Sub test()
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim TargetRng As Range
Dim CountRng As Range

Set WS1 = Worksheets(1)
Set WS2 = Worksheets(2)
WS2.Cells.Clear
Set TargetRng = WS1.Range("A1").CurrentRegion.Columns(1)
TargetRng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=WS2.Range("A1"), Unique:=True

With WS2.Range("A1").CurrentRegion.Columns(1).Cells
.Resize(.Count - 1).Offset(1, 1).Formula = "=COUNTIF(" & TargetRng.Address(0, 0, xlA1, True) & ",A2)"
End With

End Sub

回答No.2

ichhabehunger

Ａ列のデータは本当に
「１佐藤」
「２佐藤」
とかなっているのでしょうか？
少なくともＡ列は連番、Ｂ列は名前　となっているべきです。

補足

回答ありがとうございます。
氏名の左の数字は行番号を表していました。
分かり辛く済みません。

　列 A 　　 B　　　 　　Ｃ

行
１　佐藤 　2/1 　　　　 2/4
２　佐藤 　3/1 　 　　　3/3
３　佐藤 　8/2 　　 　　 8/15
４　小林 　5/3 　　 　　 5/4
５　田中 　1/20 　　 　 1/25
６　田中 　 1/26 　　　 1/28
７　田中 　 2/4 　　　　 2/6
８　田中 　 6/1 　　　　 6/30
９　田中 　 11/20 　　　11/23

　　　　　　↓
　　列　A

行
１　　佐藤
　　　　・
　　　　・
　　　　・
30　　佐藤
31　　小林
　　　　・　
　　　　・
　　　　・
60　　小林
61　　田中
　　　　・
　　　　・
　　　　・
90　　田中

このような形にしたいのですが…よろしくお願いいたします。

回答No.1

ichhabehunger

こんにちは。

意味がわかりませんよ。
＞３行には２７行挿入、１行には２９行を最後に挿入して