VBA 入力セル数に応じた表示方法

Question

前提・実現したいこと

データをA8～A17セルに入力できるようにしている。
上から順に入力する決まりとし、データの文字数も固定。
入力したデータをA2セルに表示させたい。

A8のみ入力されている場合。
A9まで入力されている場合と入力されたセルの数に応じて見栄えよく配置したい。
また、データとデータの間には、”、”を付けたい。

データ入力後、マクロを実行するとA2セルに上記イメージを表示させたい。

発生している問題・エラーメッセージ

エラーメッセージ

該当のソースコード

Sub データ表示()
Range("A2").Formula = "=A8&CHAR(10)&A9&CHAR(10)&A10&CHAR(10)&A11&CHAR(10)&A12&CHAR(10)&A13&CHAR(10)&A14&CHAR(10)&A15&CHAR(10)&A16&CHAR(10)&A17"
End Sub

試したこと

CHAR(10)を使って改行することは試しましたが、思う表示方法に近づけるにはどうしたらいいのか悩んでいます。

補足情報（FW/ツールのバージョンなど）

ここにより詳細な情報を記載してください。

Answer 1

考え方としては、まずはA8～A17セルに入っているデータの個数を計算します。
このデータの個数をnとすると、横に並べられるデータの数cは、「見栄えよく配置したい」というルールによると、
nが1～8の場合：(n - 1) \ 2 + 1 '/でないことに注意
nが9の場合：3
nが10の場合：4
となります。
後は、A8のセルからA17セルまで一個ずつセル内の文字を結合していきます。
値でも式でも生成可能ですが、例が式(Formula)でやっていますので、これにならいます。

    Dim n As Integer    'データ個数
    Dim c As Integer    '横に並べられるデータの数
    Dim i As Integer
    Dim ret As String
    Dim cel As String
    
    n = WorksheetFunction.CountIf(Range("A8:A17"), "<>")    

    If n <= 0 Then
        Exit Sub
    ElseIf n <= 8 Then
        c = (n - 1) \ 2 + 1    '/でないことに注意
    ElseIf n = 9 Then
        c = 3
    ElseIf n = 10 Then
        c = 4
    Else
        Exit Sub
    End If

    ret = "="
    For i = 1 To n
        cel = "A" & CStr(7 + i)
        ret = ret & cel
        If i < n Then
            ret = ret & "&"
            If i Mod c = 0 Then
                ret = ret & "CHAR(10)"
            Else
                ret = ret & """、"""
            End If
            ret = ret & "&"
        End If
    Next
    
    Range("A2").Formula = ret

Comments

[Mkasai]

ありがとうございました。
画面そのままにしておりまして、更新しないまま先に投稿いただいた方のを見ていたため、先の方を選ばせていただきました。
教えていただいたものを動かしてみました。
他の表示パターンを作りたい時も使えそうなんですが、知識不足の為、データ数と表示方法が変わった場合、どこをどのように修正して使ったらいいのでしょうか。
お手数をお掛け致しますが、よろよろしくお願いします。

[kenshirou]

今回の例では、データ数が8までは規則的な法則が見られたので、それを利用しました。
（いわゆる、横に並べる最大データ数c = (n - 1) \ 2 + 1 の所です。）
もし、データ数が変わる場合、表示方法も変わると思いますが、その時に表示方法に法則性があるかを考える、または簡単に計算できる方法（これは自分で用意した規則になります）でデータを表示することを考える必要があります。
実は、「簡単に計算できる方法でデータを表示」って、結構重要だったりします。
例えば、今回のケースで、データ数が9つの場合、以下のように表示していました。
●●●●、●●●●、●●●●
●●●●、●●●●、●●●●
●●●●、●●●●、●●●●
私だったら、計算を楽にしたいので、「セル幅を考慮すると、データの並ぶ数は最大4個」という条件を入れて
●●●●、●●●●、●●●●、●●●●
●●●●、●●●●、●●●●、●●●●
　　　　　　　　●●●●
のような並びで良しとするかも知れません。
（楽をしたいのでこんなことをしてみましたが、お客さんからの仕様があれば話は別ですが...）

Answer 2

ベタな書き方だとこんな感じでしょうか。

Sub test1()
    Dim s As String
    Dim cnt As Long
    cnt = Cells(Rows.Count, 1).End(xlUp).Row - 8 + 1
    Select Case cnt
        Case 1: s = Range("A8")
        Case 2: s = Range("A8") & vbCrLf & Range("A9")
        Case 3: s = Join2(Range("A8:A9")) & vbCrLf & Range("A10")
        Case 4: s = Join2(Range("A8:A9")) & vbCrLf & Join2(Range("A10:A11"))
        Case 5: s = Join2(Range("A8:A10")) & vbCrLf & Join2(Range("A11:A12"))
        Case 6: s = Join2(Range("A8:A10")) & vbCrLf & Join2(Range("A11:A13"))
        Case 7: s = Join2(Range("A8:A11")) & vbCrLf & Join2(Range("A12:A14"))
        Case 8: s = Join2(Range("A8:A11")) & vbCrLf & Join2(Range("A12:A15"))
        Case 9: s = Join2(Range("A8:A10")) & vbCrLf & Join2(Range("A11:A13")) & vbCrLf & Join2(Range("A14:A16"))
        Case 10: s = Join2(Range("A8:A11")) & vbCrLf & Join2(Range("A12:A15")) & vbCrLf & Join2(Range("A16:A17"))
    End Select
    Range("A2").Value = s
End Sub

Function Join2(r As Range) As String
    Join2 = Join(WorksheetFunction.Transpose(r), "、")
End Function

ちょっと凝った書き方だとこんなのとか。

Sub test2()
    Dim r() As Variant
    Dim setting() As Variant
    Dim s As String
    Dim r1, r2, cnt As Long
    
    setting = Array(Array(1, 1, 1), _
                    Array(2, 1, 1, 2, 2), _
                    Array(2, 1, 2, 3, 3), _
                    Array(2, 1, 2, 3, 4), _
                    Array(2, 1, 3, 4, 5), _
                    Array(2, 1, 3, 4, 6), _
                    Array(2, 1, 4, 5, 7), _
                    Array(2, 1, 4, 5, 8), _
                    Array(3, 1, 3, 4, 6, 7, 9), _
                    Array(3, 1, 4, 5, 8, 9, 10))
    
    cnt = Cells(Rows.Count, 1).End(xlUp).Row - 8 + 1
    r = WorksheetFunction.Transpose(Range("A8:A17"))
    For i = 1 To setting(cnt - 1)(0) * 2 - 1 Step 2
        r1 = setting(cnt - 1)(i)
        r2 = setting(cnt - 1)(i + 1)
        For j = r1 To r2
            s = s & r(j)
            If j <> r2 Then s = s & "、"
        Next
        s = s & vbCrLf
    Next
    Range("A2").Value = Left(s, Len(s) - 1)
End Sub

ご要望のコード。
"シート名"のところは適宜変更してください。

Sub test1()
    Dim s As String
    Dim cnt As Long
	With Worksheets("シート名")
		cnt = .Cells(Rows.Count, 1).End(xlUp).Row - 8 + 1
		Select Case cnt
			Case 1: s = .Range("A8")
			Case 2: s = .Range("A8") & vbCrLf & .Range("A9")
			Case 3: s = Join2(.Range("A8:A9")) & vbCrLf & .Range("A10")
			Case 4: s = Join2(.Range("A8:A9")) & vbCrLf & Join2(.Range("A10:A11"))
			Case 5: s = Join2(.Range("A8:A10")) & vbCrLf & Join2(.Range("A11:A12"))
			Case 6: s = Join2(.Range("A8:A10")) & vbCrLf & Join2(.Range("A11:A13"))
			Case 7: s = Join2(.Range("A8:A11")) & vbCrLf & Join2(.Range("A12:A14"))
			Case 8: s = Join2(.Range("A8:A11")) & vbCrLf & Join2(.Range("A12:A15"))
			Case 9: s = Join2(.Range("A8:A10")) & vbCrLf & Join2(.Range("A11:A13")) & vbCrLf & Join2(.Range("A14:A16"))
			Case 10: s = Join2(.Range("A8:A11")) & vbCrLf & Join2(.Range("A12:A15")) & vbCrLf & Join2(.Range("A16:A17"))
		End Select
	End With
    Range("A2").Value = s
End Sub

Function Join2(r As Range) As String
    Join2 = Join(WorksheetFunction.Transpose(r), "、")
End Function

Comments

[Mkasai]

今回もありがとうございます。テスト1のパターンで使わせていただきました。
思ってた動きができました。
ありがとうございました。

[Mkasai]

先日はありがとうございました。
教えて頂きたいことがあるのですが、対象のデータ(A8～A17セル)が、同じブックの別のシートにある場合(シート名”データ”)、最終行を取得するにはどのように修正したら動くのでしょうか。
セルは、A8~A17のところをデータ!A8～データ!A17のように変更しました。
お手数をお掛け致しますが、よろしくお願いします。

[ttyp03]

追記しました。
シート名は適宜、と書きましたが「データ」って書かれてましたね。すみません。
Worksheets("データ")
としてください。

[Mkasai]

先日はありがとうございました。　
度々すみませんが、もうひとつ教えてください。
Range("A2").Value = s
表示したいセルがA2なんですが、このA2セルのシート名を指定したい場合はどのようにしたらよろしいのでしょうか。
動かしてみたら、”データ”シートのA2セルに表示されてしまいました。
Range("A2").Value = s　の前に、 With Worksheets("データを表示させたいシート名")としてみたのですが、ダメでした。

[ttyp03]

単純に書くならこんなです。
Worksheets("データを表示させたいシート名").Range("A2").Value = s

[Mkasai]

お世話になっております。
ありがとうございます。
何度もすみませんが、教えていただけないでしょうか。
教えていただいていたコードを、実際に動かしたい実務のデータに当てはめてみました。
現在以下のようなコードになっています。

Sub test1()
Dim s As String
Dim cnt As Long
With Worksheets("作成情報")
cnt = Cells(Rows.Count, 1).End(xlUp).Row - 2 + 1
Select Case cnt
Case 1: s = Range("A2")
Case 2: s = Range("A2") & vbCrLf & Range("A3")
Case 3: s = Join2(Range("A2:A3")) & vbCrLf & Range("A4")
Case 4: s = Join2(Range("A2:A3")) & vbCrLf & Join2(Range("A4:A5"))
Case 5: s = Join2(Range("A2:A4")) & vbCrLf & Join2(Range("A5:A6"))
Case 6: s = Join2(Range("A2:A4")) & vbCrLf & Join2(Range("A5:A7"))
Case 7: s = Join2(Range("A2:A5")) & vbCrLf & Join2(Range("A6:A8"))
Case 8: s = Join2(Range("A2:A5")) & vbCrLf & Join2(Range("A6:A9"))
Case 9: s = Join2(Range("A2:A4")) & vbCrLf & Join2(Range("A5:A7")) & vbCrLf & Join2(Range("A8:A10"))
Case 10: s = Join2(Range("A2:A5")) & vbCrLf & Join2(Range("A6:A9")) & vbCrLf & Join2(Range("A10:A11"))
End Select
End With
Worksheets("着手").Range("S11").Value = s
End Sub
Function Join2(r As Range) As String
Join2 = Join(WorksheetFunction.Transpose(r), "、")
End Function

”作成情報”シートの上でマクロを実行して”着手”シートを選択するとデータが表示されているのですが、
”着手”シート上でマクロを実行しても何も変わりません。
”着手”シート上で実行するにはどのようにしたらいいのでしょうか。
また、Case 1~10の場合ありますが、Case 1の場合は、フォントサイズ11　Case 2の場合は、フォントサイズ9　等とCaseによってフォントサイズを指定することはできるのでしょうか。
よろしくお願いします。

[ttyp03]

withを使ってるのに.で指定しているところがないですね。
withの範囲内のrangeの前に.をつけてください。
フォントの指定も可能です。
ですが一旦閉じた質問でいつまでも続けられると困ります。
最初の質問の趣旨とかけ離れてしまうので、もしどうしてもわかないのであれば、新たに質問を投稿してください。
ちなみに私は自宅待機中ですので回答頻度が下がることはご承知おきください。

[Mkasai]

ありがとうございました。
いつまでも次々にすみませんでした。
再度試してみて、それでも難しいようであれば、新たに質問させていただきます。