回答編集履歴

1

ご要望

2020/04/16 04:34

投稿

ttyp03
ttyp03

スコア17000

test CHANGED
@@ -115,3 +115,61 @@
115
115
  End Sub
116
116
 
117
117
  ```
118
+
119
+ ご要望のコード。
120
+
121
+ "シート名"のところは適宜変更してください。
122
+
123
+ ```VBA
124
+
125
+ Sub test1()
126
+
127
+ Dim s As String
128
+
129
+ Dim cnt As Long
130
+
131
+ With Worksheets("シート名")
132
+
133
+ cnt = .Cells(Rows.Count, 1).End(xlUp).Row - 8 + 1
134
+
135
+ Select Case cnt
136
+
137
+ Case 1: s = .Range("A8")
138
+
139
+ Case 2: s = .Range("A8") & vbCrLf & .Range("A9")
140
+
141
+ Case 3: s = Join2(.Range("A8:A9")) & vbCrLf & .Range("A10")
142
+
143
+ Case 4: s = Join2(.Range("A8:A9")) & vbCrLf & Join2(.Range("A10:A11"))
144
+
145
+ Case 5: s = Join2(.Range("A8:A10")) & vbCrLf & Join2(.Range("A11:A12"))
146
+
147
+ Case 6: s = Join2(.Range("A8:A10")) & vbCrLf & Join2(.Range("A11:A13"))
148
+
149
+ Case 7: s = Join2(.Range("A8:A11")) & vbCrLf & Join2(.Range("A12:A14"))
150
+
151
+ Case 8: s = Join2(.Range("A8:A11")) & vbCrLf & Join2(.Range("A12:A15"))
152
+
153
+ Case 9: s = Join2(.Range("A8:A10")) & vbCrLf & Join2(.Range("A11:A13")) & vbCrLf & Join2(.Range("A14:A16"))
154
+
155
+ Case 10: s = Join2(.Range("A8:A11")) & vbCrLf & Join2(.Range("A12:A15")) & vbCrLf & Join2(.Range("A16:A17"))
156
+
157
+ End Select
158
+
159
+ End With
160
+
161
+ Range("A2").Value = s
162
+
163
+ End Sub
164
+
165
+
166
+
167
+ Function Join2(r As Range) As String
168
+
169
+ Join2 = Join(WorksheetFunction.Transpose(r), "、")
170
+
171
+ End Function
172
+
173
+
174
+
175
+ ```