Excelで項目ごとに空白セルを詰めたい

色々と調べましたが解決できません。
以下のデータの空白行が複数列（3列ずつ）ごとに
いずれかの列にバラバラに入っていて、
それをA列にランダムの件数で入っている項目ごとに詰めたいです。
空白セルには関数が入っているため、ジャンプ機能の空白セルには該当しません。
大量にあるので関数で効率よく整えたいです。
どなたかよろしくお願いいたします。

【データ】
　A 　　B 　C　 D 　E 　F 　G 　H 　I 　J
1 佐藤　●　〇　◎　空　空　空　空　空　空
2 佐藤　空　空　空　■　◇　□　空　空　空
3 佐藤　空　空　空　空　空　空　△　▽　▲
4 佐藤　●　〇　◎　空　空　空　空　空　空
5 鈴木　空　空　空　■　◇　□　空　空　空
5 高橋　空　空　空　空　空　空　△　▽　▲
6 田中　●　〇　◎　空　空　空　空　空　空
7 田中　●　〇　◎　空　空　空　空　空　空
8 田中　空　空　空　空　空　空　△　▽　▲
9 田中　●　〇　◎　空　空　空　空　空　空

【完成形】
　A 　　B 　C　 D 　E 　F 　G 　H 　I 　J
1 佐藤　●　〇　◎　■　◇　□　△　▽　▲
2 佐藤　●　〇　◎　空　空　空　空　空　空
3 鈴木　空　空　空　■　◇　□　空　空　空
4 高橋　空　空　空　空　空　空　△　▽　▲
5 田中　●　〇　◎　空　空　空　△　▽　▲
6 田中　●　〇　◎　空　空　空　空　空　空
7 田中　●　〇　◎　空　空　空　空　空　空

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

• ちなみに元データからデータにIF関数で複数列に分類してます。
  元データ→完成形にしたいです。
  
  【元データ】
  　A 　　B 　C　 D
  1 佐藤　●　〇　◎
  2 佐藤　■　◇　□
  3 佐藤　△　▽　▲
  4 佐藤　●　〇　◎
  5 鈴木　■　◇　□
  5 高橋　△　▽　▲
  6 田中　●　〇　◎
  7 田中　●　〇　◎
  8 田中　△　▽　▲
  9 田中　●　〇　◎
  
  【完成形】
  　　　│●グループ│■グループ│△グループ
  　A 　　B 　C　 D 　E 　F 　G 　H 　I 　J
  1 佐藤　●　〇　◎　■　◇　□　△　▽　▲
  2 佐藤　●　〇　◎　空　空　空　空　空　空
  3 鈴木　空　空　空　■　◇　□　空　空　空
  4 高橋　空　空　空　空　空　空　△　▽　▲
  5 田中　●　〇　◎　空　空　空　△　▽　▲
  6 田中　●　〇　◎　空　空　空　空　空　空
  7 田中　●　〇　◎　空　空　空　空　空　空

    補足日時：2021/05/21 10:41

• 回答いただきありがとうございます。
  実はデータ数はもっと多くて、簡略化したものを質問させていただいていました。
  VBAは使ったことがなくて、自身で応用できず、補足と質問をさせて頂けますと幸いです。
  
  【元データ】について
  ①「●グループ│■グループ│△グループ」
  と表記しましたが、複数の種類の関連するデータを
  それぞれのグループに振り分けています。
  ●：B列セルに「松」「竹」「梅」と入っている
  ■：「いろは」
  △：「犬」「猫」
  この場合『Case "●"～～Value』のコードを増やしたのですが、合ってますか？
  
  ②「以下のデータの空白行が複数列（3列ずつ）ごとに」
  と表記しましたが、実際は【9列ずつ】となります。
  この場合『tCol = 2 + deCol』と『Resize(1, 3)』の数字を増やしたのですが、合ってますか？
  
  実際に記載したコードを記載するので見ていただきたいです。

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

• 【同じなので省略】
  Case "松"
  tCol = 2 + deCol【省略】.Cells(n1, tCol).Resize(1, 9).Value = c.Offset(, 1).Resize(1, 9).Value
  Case "竹"
  tCol = 2 + deCol【省略】.Cells(n1,【省略】
  Case "梅"
  tCol = 2 + deCol【省略】.Cells(n1, 【省略】
  Case "いろは"
  tCol = 11 + deCol【省略】.Cells(n2,【省略】
  Case "犬"
  tCol = 20 + deCol【省略】.Cells(n3, 【省略】
  Case "猫"
  tCol = 20 + deCol【省略】.Cells(n3,【省略】
  .Cells(n1, 29 + deCol)), "<>") >= 28 Then n1 = n1 + 1
  【省略】

    補足日時：2021/05/24 10:39

No.5 ベストアンサー 回答者： Qchan1962 回答日時： 2021/05/24 16:16

#3です

ロジック自体考え直したくなりました。が、6万件以上なら配列を使った方が良さそうかも、、取敢えずパターンテストと言う事で現行の手直しです

Sub sample1()
Dim c As Range
Dim n1 As Long: n1 = 1
Dim n2 As Long: n2 = 1
Dim n3 As Long: n3 = 1
Dim deCol As Integer: deCol = 10
Dim tCol As Integer
Dim SH1 As Worksheet
Dim SH2 As Worksheet
Set SH1 = ActiveSheet '元シート
Set SH2 = Worksheets(ActiveSheet.Name) '出力シート
With SH2
For Each c In SH1.Range("A1", SH1.Cells(Rows.Count, "A").End(xlUp))
Select Case c.Offset(, 1)
Case "●"
tCol = 2 + deCol
If .Cells(n1, tCol).Value <> "" Then n1 = nRow(.Cells(n1, tCol), n1)
.Cells(n1, tCol).Resize(1, 3).Value = c.Offset(, 1).Resize(1, 3).Value
Case "■"
tCol = 5 + deCol
If .Cells(n2, tCol).Value <> "" Then n2 = nRow(.Cells(n2, tCol), n2)
.Cells(n2, tCol).Resize(1, 3).Value = c.Offset(, 1).Resize(1, 3).Value
Case "△"
tCol = 8 + deCol
If .Cells(n3, tCol).Value <> "" Then n3 = nRow(.Cells(n3, tCol), n3)
.Cells(n3, tCol).Resize(1, 3).Value = c.Offset(, 1).Resize(1, 3).Value
End Select
If Application.CountIf(.Range(.Cells(n1, 2 + deCol), .Cells(n1, 10 + deCol)), "<>") >= 9 Then n1 = n1 + 1
.Cells(Application.Max(n1, n2, n3), deCol + 1).Value = c.Value
If c <> c.Offset(1) Then
n1 = Application.Max(n1, n2, n3) + 1
n2 = n1: n3 = n1
End If
Next
End With
' Range(Cells(n, "A"), Cells(Cells(Rows.Count, "A").End(xlUp).Row, "J")).ClearContents
End Sub
Public Function nRow(myCel As Range, n As Long) As Long
Dim i As Integer: i = 0
Do While myCel.Offset(i).Value <> ""
i = i + 1
Loop
nRow = n + i
End Function

この回答へのお礼

こちらでできました！！！！！
すごい！！！非常に助かりました。。
親身になってアドバイスいただきありがとうございました！！

お礼日時：2021/05/25 09:25

No.4 回答者： mike_g 回答日時： 2021/05/24 13:09

[No.1お礼]へのコメント

》 手動で一個ずつコピペするしかないですかね
私の構想(添付図参照、一旦「項目」ごとに別場所に敢えてエラー付きで抽出⇒全データの値化⇒Alt+HFDGでエラー値の削除⇒上方へシフト)とは異なるけど、手間は似たようなものかも。
数式だけじゃ無理と諦めて、

を聴き始めました。

この回答へのお礼

なるほど！そういう方法もあるのですね。
ご丁寧にありがとうございます。
今回は「項目」が6万件以上あるので、君待てどもを聴こうと思います笑
件数が少ないときに試してみます、ありがとうございました(^^)

お礼日時：2021/05/24 14:08

No.3 回答者： Qchan1962 回答日時： 2021/05/24 11:32

こんにちは

処理の内容についてですが、表組のB列の値がシンボルとなり
B列C列D列の同じ行を１つの塊として処理しています。

＞【9列ずつ】となります
Resize(1, 9).Valueで良いと思います

シンボルが増える場合は示されている通りCaseを増やし
出力セルを指定すれば良いです

検証する環境が無いので確かではないのですが
変数n?はグループの対象行なので出力するカラムが3か所なら
示されているコードで良いように思います。
理解されているように思いますので、試してみてはいかがでしょう。

試す環境は、コピーブックを作り任意の名前の新規シートを作って
コードのSet SH2 = Worksheets(ActiveSheet.Name) '出力シート
のActiveSheet.Nameを　"任意のシート名"　として
データのあるシートを表示してAlt+F8でダイアログから
プロシージャを実行して検証してください。

このロジックの場合
5 田中　●　〇　◎　空　空　空　△　▽　▲
6 田中　●　〇　◎　空　空　空　空　空　空
7 田中　●　〇　◎　空　空　空　空　空　空
の結果に対応するため

もし、6か所の列が出力対象になる場合は、変数n？対応部分の全てを増やす必要があります

変数nを1つで対応すると
5 田中　●　〇　◎　空　空　空　空　空　空
6 田中　●　〇　◎　空　空　空　△　▽　▲
7 田中　●　〇　◎　空　空　空　空　空　空
のような結果になります。（例のデータで）

この回答へのお礼

ご確認ありがとうございます。
実際に試してみたところ、かなり近い形になってきました。
VBAってすごいですね。。('Д')

ところで、以下のようになってしまったのですが、
どこをどのようなコードに修正したらいいでしょうか。
何度もすみません、よろしくお願いいたします。

【元データ】
　A 　　B 　C　 D
10 伊藤　●　〇　◎　　
11 伊藤　●　〇　◎
12 伊藤　■　◇　□
13 伊藤　■　◇　□
13 伊藤　■　◇　□
13 伊藤　△　▽　▲
14 渡辺　●　〇　◎

【VBA】
　　A 　　B 　C　 D 　E 　F 　G 　H 　I 　J
10 伊藤　●　〇　◎　■　◇　□　△　▽　▲
11 伊藤　●　〇　◎　■　◇　□　空　空　空
12 渡辺　●　〇　◎　■　◇　□　空　空　空　
※【■グループ】について本来は「伊藤」のデータが渡辺にずれ込んでしまっている

【理想の完成形】
　　A 　　B 　C　 D 　E 　F 　G 　H 　I 　J
10 伊藤　●　〇　◎　■　◇　□　△　▽　▲
11 伊藤　●　〇　◎　■　◇　□　空　空　空
12 伊藤　空　空　空　■　◇　□　空　空　空　
13 渡辺　●　〇　◎　空　空　空　空　空　空

お礼日時：2021/05/24 14:36

No.2 回答者： Qchan1962 回答日時： 2021/05/22 14:35

こんにちは、

お呼びでない事は理解しておりますが
VBAで処理する方法です。（補足の【元データ】の場合）

標準モジュールに

Sub sample1()
Dim c As Range
Dim n1 As Long: n1 = 1
Dim n2 As Long: n2 = 1
Dim n3 As Long: n3 = 1
Dim deCol As Integer: deCol = 10
Dim tCol As Integer
Dim SH1 As Worksheet
Dim SH2 As Worksheet
Set SH1 = ActiveSheet '元シート
Set SH2 = Worksheets(ActiveSheet.Name) '出力シート
With SH2
For Each c In SH1.Range("A1", SH1.Cells(Rows.Count, "A").End(xlUp))
Select Case c.Offset(, 1)
Case "●"
tCol = 2 + deCol
If .Cells(n1, tCol).Value <> "" Then n1 = n1 + 1
.Cells(n1, tCol).Resize(1, 3).Value = c.Offset(, 1).Resize(1, 3).Value
Case "■"
tCol = 5 + deCol
If .Cells(n2, tCol).Value <> "" Then n2 = n2 + 1
.Cells(n2, tCol).Resize(1, 3).Value = c.Offset(, 1).Resize(1, 3).Value
Case "△"
tCol = 8 + deCol
If .Cells(n3, tCol).Value <> "" Then n3 = n3 + 1
.Cells(n3, tCol).Resize(1, 3).Value = c.Offset(, 1).Resize(1, 3).Value
End Select
If Application.CountIf(.Range(.Cells(n1, 2 + deCol), .Cells(n1, 10 + deCol)), "<>") >= 9 Then n1 = n1 + 1
.Cells(n1, deCol + 1).Value = c.Value
If c <> c.Offset(1) Then
n1 = n1 + 1: n2 = n1: n3 = n1
End If
Next
End With
' Range(Cells(n, "A"), Cells(Cells(Rows.Count, "A").End(xlUp).Row, "J")).ClearContents

End Sub

念のため　K列より出力しています。
A1セルより出力したい場合は、deCol = 10　を　deCol = 0　として
最後の行の ' Range(・・・　の　'を削除してください。
（元データは消えてしまいますので注意）

別シートに書き出す場合は、書き出しシートを別シートにしてください
例　実際にあるシート名を設定
Set SH2 = Worksheets("完成形") '出力シート　
別シートの場合、最後の行の ' Range(・・・　の　'を削除は不要です
（コード自体不要）

この回答へのお礼

ありがとうございます！

お礼日時：2021/05/24 14:34

No.1 回答者： mike_g 回答日時： 2021/05/22 08:02

ここの添付図の左上の元データを右下の形にするまでは、数式だけで比較的簡単にできたのですが、右上の完成形にするのはヤッテヤレナイこと

はないけど、ご紹介するには手数が多すぎて・・・(*^_^*)

この回答へのお礼

やはりそうですよね。。
手動で一個ずつコピペするしかないですかね。。
試していただき、本当にありがとうございました！！
他の方の回答をお待ちしたいと思います。

お礼日時：2021/05/24 10:17