teratail
回答率
85.47%
質問するログイン新規登録
トップVBに関する質問Excelマクロで指定文字数（31文字）でその文字数の一番後ろの指定文字で改行するExcelマクロの記述方法について

編集履歴

回答編集履歴

6

エレガントなコードに変更

2016/11/25 07:11

投稿

jawa
jawa

スコア3013

test CHANGED
@@ -186,7 +186,7 @@
186
186
 
187
187
  '次の行を作る前に改行を追記
188
188
 
189
- strOutput = strOutput & strLine & vbLf & vbLf
189
+ strOutput = strOutput & vbLf & vbLf
190
190
 
191
191
  Loop
192
192
 

5

エレガントなコードに変更

2016/11/25 07:11

投稿

jawa
jawa

スコア3013

test CHANGED
@@ -104,8 +104,6 @@
104
104
 
105
105
  'セル(A1)から文字列を取得
106
106
 
107
- 'strRest = Sheet5.Range("A1").Value
108
-
109
107
  strRest = sht.Range("A1").Value
110
108
 
111
109
 
@@ -164,98 +162,114 @@
164
162
 
165
163
 
166
164
 
167
- '切り出した文字列に改行をつけて出力
165
+ '切り出した文字列を出力
168
-
166
+
169
- 'strOutput = strOutput & strLine & vbCrLf
167
+ strOutput = strOutput & strLine
168
+
169
+
170
+
171
+ '切り出した文字列分を未出力文字列から除去
172
+
173
+ strRest = Mid(strRest, Len(strLine) + 1)
174
+
175
+
176
+
177
+ If strRest = "" Then
178
+
179
+ '未出力文字列がなくなったら終了
180
+
181
+ Exit Do
182
+
183
+ End If
184
+
185
+
186
+
187
+ '次の行を作る前に改行を追記
170
188
 
171
189
  strOutput = strOutput & strLine & vbLf & vbLf
172
190
 
173
-
191
+ Loop
192
+
193
+
194
+
174
-
195
+ ''結果をB1セルに出力
196
+
197
+ 'sht.Range("B1") = strOutput
198
+
199
+
200
+
201
+ '結果をクリップボードに出力
202
+
203
+ Dim objClip As New DataObject
204
+
205
+ With objClip
206
+
207
+ .SetText strOutput 'クリップボードにセットする値を指定
208
+
209
+ .PutInClipboard 'クリップボードに格納
210
+
211
+ End With
212
+
213
+
214
+
215
+ End Sub
216
+
217
+ ```
218
+
219
+
220
+
221
+ ソース②：正規表現検索FindEx(メインロジックで使用している為ファンクション名は変更不可)
222
+
223
+ ```
224
+
225
+ '正規表現検索（最終マッチ文字までの文字長を返す）
226
+
227
+ Function FindEx(ByVal vsTarget As String, ByVal vsPattern As String) As Integer
228
+
229
+
230
+
231
+ Dim iIdx As Integer
232
+
233
+ Dim objReg As Object
234
+
235
+ Dim objMatchs
236
+
237
+
238
+
239
+ Set objReg = CreateObject("VBScript.RegExp")
240
+
241
+
242
+
243
+ With objReg
244
+
245
+ .Pattern = vsPattern
246
+
247
+ .IgnoreCase = True
248
+
249
+ .Global = True
250
+
251
+ '正規表現検索
252
+
253
+ Set objMatchs = .Execute(vsTarget)
254
+
255
+ If objMatchs.Count = 0 Then
256
+
257
+ 'マッチしなかった場合-1
258
+
259
+ FindEx = -1
260
+
261
+ Else
262
+
263
+ 'マッチ数を取得
264
+
265
+ iIdx = objMatchs.Count - 1
266
+
175
- '切り出した文字列分を未出力文字列から除去
267
+ 'マッチした候補の最終文字列までの文字長を返す
176
-
268
+
177
- strRest = Mid(strRest, Len(strLine) + 1)
269
+ FindEx = objMatchs(iIdx).FirstIndex + objMatchs(iIdx).Length
178
-
179
-
180
-
181
- If strRest = "" Then
182
-
183
- '未出力文字列がなくなったら終了
184
-
185
- Exit Do
186
270
 
187
271
  End If
188
272
 
189
- Loop
190
-
191
-
192
-
193
- '結果をメッセージ表示
194
-
195
- 'MsgBox strOutput
196
-
197
- sht.Range("B1") = strOutput
198
-
199
-
200
-
201
- End Sub
202
-
203
- ```
204
-
205
-
206
-
207
- ソース②：正規表現検索FindEx(メインロジックで使用している為ファンクション名は変更不可)
208
-
209
- ```
210
-
211
- '正規表現検索（最終マッチ文字までの文字長を返す）
212
-
213
- Function FindEx(ByVal vsTarget As String, ByVal vsPattern As String) As Integer
214
-
215
-
216
-
217
- Dim iIdx As Integer
218
-
219
- Dim objReg As Object
220
-
221
- Dim objMatchs
222
-
223
-
224
-
225
- Set objReg = CreateObject("VBScript.RegExp")
226
-
227
-
228
-
229
- With objReg
230
-
231
- .Pattern = vsPattern
232
-
233
- .IgnoreCase = True
234
-
235
- .Global = True
236
-
237
- '正規表現検索
238
-
239
- Set objMatchs = .Execute(vsTarget)
240
-
241
- If objMatchs.Count = 0 Then
242
-
243
- 'マッチしなかった場合-1
244
-
245
- FindEx = -1
246
-
247
- Else
248
-
249
- 'マッチ数を取得
250
-
251
- iIdx = objMatchs.Count - 1
252
-
253
- 'マッチした候補の最終文字列までの文字長を返す
254
-
255
- FindEx = objMatchs(iIdx).FirstIndex + objMatchs(iIdx).Length
256
-
257
- End If
258
-
259
273
 
260
274
 
261
275
  End With

4

修正

2016/11/25 07:09

投稿

jawa
jawa

スコア3013

test CHANGED
@@ -70,12 +70,24 @@
70
70
 
71
71
 
72
72
 
73
+ ソース①：メインロジック（関数名は任意でOK）
74
+
73
75
  ```
74
76
 
75
77
  Sub Test2()
76
78
 
79
+ Dim sht As Worksheet
80
+
81
+ Set sht = Sheets("Sheet5") 'シート名は任意に指定
82
+
83
+ 'Set sht = ActiveSheet 'アクティブシートでマクロ実行する場合はこちらでも可
84
+
85
+
86
+
77
87
  Dim aryPtn As Variant
78
88
 
89
+ Dim ptn As Variant
90
+
79
91
  aryPtn = Array("、", "。", "★", "」", "｣", "）", "\)", "\!", "\?", "！", "？", "・+")
80
92
 
81
93
 
@@ -92,7 +104,9 @@
92
104
 
93
105
  'セル(A1)から文字列を取得
94
106
 
107
+ 'strRest = Sheet5.Range("A1").Value
108
+
95
- strRest = Sheet5.Range("A1").Value
109
+ strRest = sht.Range("A1").Value
96
110
 
97
111
 
98
112
 
@@ -152,7 +166,9 @@
152
166
 
153
167
  '切り出した文字列に改行をつけて出力
154
168
 
155
- strOutput = strOutput & strLine & vbCrLf
169
+ 'strOutput = strOutput & strLine & vbCrLf
170
+
171
+ strOutput = strOutput & strLine & vbLf & vbLf
156
172
 
157
173
 
158
174
 
@@ -176,13 +192,21 @@
176
192
 
177
193
  '結果をメッセージ表示
178
194
 
179
- MsgBox strOutput
195
+ 'MsgBox strOutput
196
+
197
+ sht.Range("B1") = strOutput
180
198
 
181
199
 
182
200
 
183
201
  End Sub
184
202
 
185
-
203
+ ```
204
+
205
+
206
+
207
+ ソース②：正規表現検索FindEx(メインロジックで使用している為ファンクション名は変更不可)
208
+
209
+ ```
186
210
 
187
211
  '正規表現検索（最終マッチ文字までの文字長を返す）
188
212
 
@@ -258,22 +282,42 @@
258
282
 
259
283
  今日は、朝から天気が良く、真夏日になるらしいので、
260
284
 
285
+
286
+
261
287
  熱中症対策には十分気を付けたいです。（笑）
262
288
 
289
+
290
+
263
291
  庭にブールーベリーやひまわりが植えているので暑くなる前に水やり
264
292
 
293
+
294
+
265
295
  をしたいと思ます★
266
296
 
297
+
298
+
267
299
  ブルーベリーの実がなってきて色づいてきたのでもう少ししたら収穫
268
300
 
301
+
302
+
269
303
  できるのではないかと今から楽しみでなりません！？
270
304
 
305
+
306
+
271
307
  朝から水やりをした後に近所でラジオ体操をやっているので、
272
308
 
309
+
310
+
273
311
  姪っ子と甥っ子を連れて、ラジオ体操に今から行ってきます。
274
312
 
313
+
314
+
275
315
  「眠い」と思わず声にでてしまう時も多々ありますが、
276
316
 
317
+
318
+
277
319
  さぼらないように頑張りたいと思います。
278
320
 
279
321
 
322
+
323
+

3

誤字修正

2016/11/24 01:06

投稿

jawa
jawa

スコア3013

test CHANGED
@@ -100,23 +100,29 @@
100
100
 
101
101
  iLen = -1
102
102
 
103
+
104
+
103
105
  'ループ処理
104
106
 
105
107
  Do
106
108
 
107
- '31文字分を抽出
109
+ '先頭31文字を切り出す
108
110
 
109
111
  strLine = Left(strRest, 31)
110
112
 
111
113
 
112
114
 
115
+ '文字長の初期化
116
+
117
+ iLen = -1
118
+
119
+
120
+
113
121
  '置換パターンの数だけループ処理
114
122
 
115
- iLen = 0
116
-
117
123
  For Each ptn In aryPtn
118
124
 
119
- '最後にマッチした区切り文字までの長さ
125
+ '最後にマッチした区切り文字までの文字長を調べる
120
126
 
121
127
  Dim iLenWk As Integer
122
128
 
@@ -124,7 +130,7 @@
124
130
 
125
131
  If iLenWk > iLen Then
126
132
 
127
- '一番長い文字列を採用
133
+ '長い文字長を採用していく
128
134
 
129
135
  iLen = iLenWk
130
136
 
@@ -136,7 +142,7 @@
136
142
 
137
143
  If iLen > 0 Then
138
144
 
139
- '区切り文字が見つかった場合
145
+ '区切り文字が見つかった場合、文字列を切り出す
140
146
 
141
147
  strLine = Left(strLine, iLen)
142
148
 
@@ -178,7 +184,7 @@
178
184
 
179
185
 
180
186
 
181
- '正規表現置換
187
+ '正規表現検索（最終マッチ文字までの文字長を返す）
182
188
 
183
189
  Function FindEx(ByVal vsTarget As String, ByVal vsPattern As String) As Integer
184
190
 
@@ -204,7 +210,7 @@
204
210
 
205
211
  .Global = True
206
212
 
207
- '正規表現置換
213
+ '正規表現検索
208
214
 
209
215
  Set objMatchs = .Execute(vsTarget)
210
216
 
@@ -220,7 +226,7 @@
220
226
 
221
227
  iIdx = objMatchs.Count - 1
222
228
 
223
- 'マッチした候補の最終文字列までの文字長
229
+ 'マッチした候補の最終文字列までの文字長を返す
224
230
 
225
231
  FindEx = objMatchs(iIdx).FirstIndex + objMatchs(iIdx).Length
226
232
 

2

追記（変換結果の記載）

2016/11/22 12:15

投稿

jawa
jawa

スコア3013

test CHANGED
@@ -243,3 +243,31 @@
243
243
 
244
244
 
245
245
  参考になれば幸いです。
246
+
247
+
248
+
249
+ 変換結果
250
+
251
+ ---
252
+
253
+ 今日は、朝から天気が良く、真夏日になるらしいので、
254
+
255
+ 熱中症対策には十分気を付けたいです。（笑）
256
+
257
+ 庭にブールーベリーやひまわりが植えているので暑くなる前に水やり
258
+
259
+ をしたいと思ます★
260
+
261
+ ブルーベリーの実がなってきて色づいてきたのでもう少ししたら収穫
262
+
263
+ できるのではないかと今から楽しみでなりません！？
264
+
265
+ 朝から水やりをした後に近所でラジオ体操をやっているので、
266
+
267
+ 姪っ子と甥っ子を連れて、ラジオ体操に今から行ってきます。
268
+
269
+ 「眠い」と思わず声にでてしまう時も多々ありますが、
270
+
271
+ さぼらないように頑張りたいと思います。
272
+
273
+

1

修正

2016/11/22 12:07

投稿

jawa
jawa

スコア3013

test CHANGED
@@ -20,43 +20,41 @@
20
20
 
21
21
  （ループ１開始 ～対象文字列がなくなるまでループ処理～）
22
22
 
23
- ②対象文字列から先頭３１文字分を切り出す
23
+ 　②対象文字列から先頭３１文字分を切り出す
24
-
25
-
26
-
24
+
25
+
26
+
27
- （ループ２開始 ～区切り文字の数だけループ処理～）
27
+ 　　（ループ２開始 ～区切り文字の数だけループ処理～）
28
-
28
+
29
- ③切り出した文字列から区切り文字を検索する
29
+ 　　　③切り出した文字列から区切り文字を検索する
30
30
 
31
31
 
32
32
 
33
- ④区切り文字が含まれていた場合、最後の区切り文字までの文字長を取得
33
+ 　　　 ④区切り文字が含まれていた場合、最後の区切り文字までの文字長を取得
34
-
34
+
35
- ※全ての区切り文字で最長となる文字数を調べる
35
+ 　　　※全ての区切り文字で最長となる文字数を調べる
36
-
37
-
38
-
36
+
39
- （ループ２ここまで）
37
+ 　　（ループ２ここまで）
40
38
 
41
39
 
42
40
 
43
- ⑤で対象文字列（３１文字）から最大の文字長となる区切り位置までの文字列を切り出す
41
+ 　 ⑤対象文字列（３１文字）から最大の文字長となる区切り位置までの文字列を切り出す
44
-
42
+
45
- ※区切り文字がひとつも見つからなかった場合、対象文字（３１文字）をそのまま使用とする
43
+ 　 ※区切り文字がひとつも見つからなかった場合、対象文字（３１文字）をそのまま使用とする
46
-
47
-
48
-
44
+
45
+
46
+
49
- ⑥⑤で切り出した文字列に改行をつけて出力用文字列に連結する
47
+ 　 ⑥⑤で切り出した文字列に改行をつけて出力用文字列に連結する
50
-
51
-
52
-
48
+
49
+
50
+
53
- ⑦出力した文字数分、対象文字列の先頭を削る
51
+ 　 ⑦出力した文字数分、対象文字列の先頭を削る
54
-
52
+
55
- ⇒これが次回の対象文字列となります。
53
+ 　⇒これが次回の対象文字列となります。
56
-
57
-
58
-
54
+
55
+
56
+
59
- ⑧対象文字列がなくなったらループ１終了
57
+ 　 ⑧対象文字列がなくなったらループ１終了
60
58
 
61
59
  （ループ１ここまで）
62
60