teratail header banner
teratail header banner
質問するログイン新規登録

回答編集履歴

1

ご要望

2020/04/16 04:34

投稿

ttyp03
ttyp03

スコア17002

answer CHANGED
@@ -56,4 +56,33 @@
56
56
  Next
57
57
  Range("A2").Value = Left(s, Len(s) - 1)
58
58
  End Sub
59
+ ```
60
+ ご要望のコード。
61
+ "シート名"のところは適宜変更してください。
62
+ ```VBA
63
+ Sub test1()
64
+ Dim s As String
65
+ Dim cnt As Long
66
+ With Worksheets("シート名")
67
+ cnt = .Cells(Rows.Count, 1).End(xlUp).Row - 8 + 1
68
+ Select Case cnt
69
+ Case 1: s = .Range("A8")
70
+ Case 2: s = .Range("A8") & vbCrLf & .Range("A9")
71
+ Case 3: s = Join2(.Range("A8:A9")) & vbCrLf & .Range("A10")
72
+ Case 4: s = Join2(.Range("A8:A9")) & vbCrLf & Join2(.Range("A10:A11"))
73
+ Case 5: s = Join2(.Range("A8:A10")) & vbCrLf & Join2(.Range("A11:A12"))
74
+ Case 6: s = Join2(.Range("A8:A10")) & vbCrLf & Join2(.Range("A11:A13"))
75
+ Case 7: s = Join2(.Range("A8:A11")) & vbCrLf & Join2(.Range("A12:A14"))
76
+ Case 8: s = Join2(.Range("A8:A11")) & vbCrLf & Join2(.Range("A12:A15"))
77
+ Case 9: s = Join2(.Range("A8:A10")) & vbCrLf & Join2(.Range("A11:A13")) & vbCrLf & Join2(.Range("A14:A16"))
78
+ Case 10: s = Join2(.Range("A8:A11")) & vbCrLf & Join2(.Range("A12:A15")) & vbCrLf & Join2(.Range("A16:A17"))
79
+ End Select
80
+ End With
81
+ Range("A2").Value = s
82
+ End Sub
83
+
84
+ Function Join2(r As Range) As String
85
+ Join2 = Join(WorksheetFunction.Transpose(r), "、")
86
+ End Function
87
+
59
88
  ```