[[20230123231422]]　『文頭の数字を利用したタブ結合』（クロレッツ）　ページの最後に飛ぶ

『文頭の数字を利用したタブ結合』（クロレッツ）

以下のように問題文が一行ごとにセルが分かれている場合、どうすれば一問ごとにセルを結合できますか？　

例）
1行目）Text
2行目）1. question
3行目）(A) 1 (B) 2
4行目）(C) 3 (D) 4
5行目）
6行目）2. problem
7行目）(A)korea (B)japan
8行目）(C)spain (D)rusia
9行目）
10行目）3.・・・

1行目～5行目、6行目～９行目、10～・・・
という風に結合したいです
ちなみに列はすべて同列内なので問題ないです

＜使用 Excel：Microsoft365、使用 OS：unknown ＞

合ってるかわかりませんが

 Sub test()
     Dim i As Long
     For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row Step 4
         Cells(i, "B") = Cells(i, "A") & " " & Cells(i + 1, "A") & " " & Cells(i + 2, "A")
     Next
 End Sub

 結果図

    |[A]              |[B]                                           
 [1]|Text             |                                              
 [2]|1. question      |1. question (A) 1 (B) 2 (C) 3 (D) 4           
 [3]|(A) 1 (B) 2      |                                              
 [4]|(C) 3 (D) 4      |                                              
 [5]|                 |                                              
 [6]|2. problem       |2. problem (A)korea (B)japan (C)spain (D)rusia
 [7]|(A)korea (B)japan|                                              
 [8]|(C)spain (D)rusia|

行を詰めるのであれば

 Sub test2()
     Dim i As Long, r As Long
     Range("B1") = "結合列"
     For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row Step 4
         r = Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Row
         Cells(r, "B") = Cells(i, "A") & " " & Cells(i + 1, "A") & " " & Cells(i + 2, "A")
     Next
 End Sub

 結果図

    |[A]              |[B]                                           
 [1]|Text             |結合列                                        
 [2]|1. question      |1. question (A) 1 (B) 2 (C) 3 (D) 4           
 [3]|(A) 1 (B) 2      |2. problem (A)korea (B)japan (C)spain (D)rusia
 [4]|(C) 3 (D) 4      |                                              
 [5]|                 |                                              
 [6]|2. problem       |                                              
 [7]|(A)korea (B)japan|                                              
 [8]|(C)spain (D)rusia|

（フォーキー） 2023/01/24(火) 01:13:45

 「タブ結合」というのがどのようなものか知らないので、単なるセル結合だとして、
 また、それによって何が改善されるのかも不明ですが、
 以下のようなことなんでしょうか。
 （各ブロックの間には、ちょうど1行の空白行がある前提です。）

 Sub main()
     Dim myRange As Range
     Dim area As Range
     Dim s$

     Set myRange = Range("A1", Cells(Rows.Count, "A").End(xlUp))
     For Each area In myRange.SpecialCells(xlCellTypeConstants).Areas
         s = getText(area)   '文字列を取得
         area.ClearContents
         Call myMerge(area)  'セル結合
         area(1) = s
     Next
 End Sub

 Function getText(area As Range) As String
     Dim ary
     ary = Application.Transpose(area.Value)
     getText = Join(ary, vbLf)
 End Function

 Function myMerge(area As Range)
     Dim area2 As Range
     Set area2 = area.Resize(area.Rows.Count + 1)
     With area2
         .Merge              'セル結合
         .HorizontalAlignment = xlLeft
         .VerticalAlignment = xlCenter
         .WrapText = False
         .Orientation = 0
         .AddIndent = False
         .IndentLevel = 0
         .ShrinkToFit = False
         .ReadingOrder = xlContext
     End With
 End Function
 　
（γ） 2023/01/24(火) 06:32:13

どうもご丁寧に返信いただいてありがとうございます。
おそらく自分の例示が悪いのが原因でうまくいかなかったので、出直そうと思います。
解答者様にはとても感謝してます。
（クロレッツ） 2023/01/24(火) 20:44:20

 どう、うまくいかないのでしょうか？
 「こうゆう作業をしてみたが、結果こうでダメだった」ということを説明しないと、回答した方にも、もやもや感が残ると思います。

 提示の例だと、作業列を使って、簡単な数式で対応できると思いますが、以下でどうでしょうか？
 「セルを結合」というのがセルのマージの意味なら数式では無理なのでスルーして下さい。

     __A_____________  __B___  __C  __D  __E__________________________________________
 1   Text              作業列       No   問題文                                       
 2   1.question             1         1  1.question♪(A)1(B)2♪(C)3(D)4               
 3   (A)1(B)2               1         2  2.problem♪(A)korea(B)japan♪(C)spain(D)rusia
 4   (C)3(D)4               1                                                         
 5                          1                                                         
 6   2.problem              2                                                         
 7   (A)korea(B)japan       2                                                         
 8   (C)spain(D)rusia       2

 [B2]  =LET(_No,LEFT(A2)*1,IF(ISNUMBER(_No),_No,B1))　　↓にコピー
 [D2]  =UNIQUE(B2:B8)　自動でスピルします。
 [E2]  =TEXTJOIN("♪",TRUE,FILTER($A$2:$A$8,$B$2:$B$8=D2,""))　↓にコピー

 わかりやすいい様に「♪」で区切ってますが、タブ区切なら↓
 [E2]  =TEXTJOIN(CHAR(9),TRUE,FILTER($A$2:$A$8,$B$2:$B$8=D2,""))

（まる） 2023/01/24(火) 21:36:15

[[20230124205218]]『1問ごとにセル結合』（キシリトール）

 名前を変えて再質問されています。
 どちらで進行するか決めて欲しいですね
（´・ω・`） 2023/01/24(火) 21:38:04

コメント返信：

[ 一覧(最新更新順) ]

[[20230123231422]] 『文頭の数字を利用したタブ結合』（クロレッツ） ページの最後に飛ぶ

[[20230123231422]]　『文頭の数字を利用したタブ結合』（クロレッツ）　ページの最後に飛ぶ