[過去ﾛｸﾞ] VBAなんでも質問スレ Part2 [転載禁止]©2ch.net (1002ﾚｽ)
上下前次1-新
このｽﾚｯﾄﾞは過去ﾛｸﾞ倉庫に格納されています｡
次ｽﾚ検索 歴削→次ｽﾚ 栞削→次ｽﾚ 過去ﾛｸﾞﾒﾆｭｰ
ﾘﾛｰﾄﾞ規制です｡10分ほどで解除するので､他のﾌﾞﾗｳｻﾞへ避難してください｡
978(1): 2020/12/25(金)06:38 ID:wEXLIZpl(1) AAS
もしかしてフィルタで非表示になってるセルってVBAで値参照できない？
979: 2020/12/26(土)04:11 ID:NJB8+QKa(1) AAS
>>978
自己解決
980: 2021/05/14(金)13:33 ID:Kf/7Ycdt(1/3) AAS
WordのVBAで質問させてください。
文書内の２種類の括弧「」『』の中にある改行だけを削除するマクロを作りたいと思っています。
例えば以下のような文章に対してマクロをかけたときに
「み
か
ん」
ば
な
な
「り
ん
ご
」
以下のような結果になるマクロです。
「みかん」
ば
な
な
「りんご」
つづきます
981: 2021/05/14(金)13:34 ID:Kf/7Ycdt(2/3) AAS
Sub 括弧内の改行を削除()
Dim myRange As Range
Set myRange = ActiveDocument.Range(0, 0)
With myRange.Find
.Text = "[「『""]*^13*[""』」]"
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
Do While .Execute = True
With myRange.Find
.Text = "^13"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
DoEvents
End With
Loop
End With
Set myRange = Nothing
End Sub
982(1): 2021/05/14(金)13:35 ID:Kf/7Ycdt(3/3) AAS
自分なりに以上のようなマクロを組んでみたのですが、実行してみると、
最初の「みかん」の改行は削除されるのですが、そのあとの「りんご」の改行が削除されません
やり方をお教えいただけると助かります。
983: 2021/05/14(金)13:58 ID:dwsPOlKo(1) AAS
馬鹿には無理
984: 2021/05/14(金)20:08 ID:YZr2qR8x(1) AAS
正規表現使えば一発じゃん。
VBAって正規表現使えるんだっけ？
985: 2021/05/14(金)20:22 ID:pWuJPMFY(1) AAS
RegExpオブジェクトを使えば。
面倒だから俺はどうしてもというとき以外は使わない。
986: 2021/05/14(金)20:24 ID:6X3W89ka(1) AAS
Wordなら最初から正規表現もどきが使えるから、Excel VBAよりはちょっとだけ楽に文字列操作ができる
987: 2021/05/15(土)04:20 ID:rI+eK0KL(1) AAS
>>982
正規表現でマルチラインを設定して改行を空文字に置換
RegExpオブジェクトの使い方は、他の言語より面倒な書き方だったりするけど文字を操作するなら必須だと思うよ
988: 2021/06/10(木)19:25 ID:CLREf/YK(1) AAS
splitでいい感じに分割して判定してreplaceで改行無くしてくっ付けろ
「」は自分でつけたせ
989(1): 2021/08/25(水)17:06 ID:qYcBJ8fd(1/5) AAS
あんま実験してないから文句いうなよ
まずはさ、アホでも考えられるような地道な形でやるべきだと思うわ
そのあとに、効率性とか考えて無駄排除したりすればいいわ
Sub MainProcess()
Dim text As String
text = Sheet1.Cells(1, 1) 'A1に括弧が含まれる文字列をいれろ
Const right1 As String = "「"
Const left1 As String = "」"
Const right2 As String = "『"
Const left2 As String = "』"
text = MakeText(text, right1, left1)
text = MakeText(text, right2, left2)
'B1に結果が返ってくるぞ。途中結果はメッセージボックスで順次表示されるからループ終わるまで何度もOKおせ
Sheet1.Cells(1, 2) = text
End Sub
990(1): 2021/08/25(水)17:06 ID:qYcBJ8fd(2/5) AAS
>>989の続き
Function MakeText(text As String, rightChar As String, leftChar As String) As String
Dim startPosition As Integer
Dim endPosition As Integer
Dim InstrStartPosition As Integer
InstrStartPosition = 1
Do While InStr(InstrStartPosition, text, rightChar) <> 0
startPosition = InStr(InstrStartPosition, text, rightChar)
If startPosition <> 0 Then
endPosition = InStr(startPosition + 1, text, leftChar)
End If
Dim midText As String
midText = Mid(text, startPosition, endPosition - startPosition + 1)
Dim midTextChanged As String
midTextChanged = Replace(midText, vbLf, "")
text = Replace(text, midText, midTextChanged)
InstrStartPosition = startPosition + Len(midTextChanged)
MsgBox "無限ループになっちゃった時はctrl + Breakを押せ" & vbCrLf & vbCrLf & text
Loop
MakeText = text
End Function
991: 2021/08/25(水)17:07 ID:qYcBJ8fd(3/5) AAS
つかさ、rightとleftが逆だったわ
まぁ動くからいいわ
992: 2021/08/25(水)17:18 ID:qYcBJ8fd(4/5) AAS
あれだ、最期の方に「だけが単独であると無限ループだわな
ループの条件にその辺の修正いれておいてくれ
もう寝る
993: 2021/08/25(水)17:34 ID:qYcBJ8fd(5/5) AAS
おっきした
>>990を↓に修正
Function MakeText(text As String, rightChar As String, leftChar As String) As String
Dim startPosition As Integer
Dim endPosition As Integer
Dim InstrStartPosition As Integer
InstrStartPosition = 1
Do While InStr(InstrStartPosition, text, rightChar) <> 0
startPosition = InStr(InstrStartPosition, text, rightChar)
If startPosition <> 0 Then
endPosition = InStr(startPosition + 1, text, leftChar)
End If
Dim midText As String
midText = Mid(text, startPosition, endPosition - startPosition + 1)
Dim midTextChanged As String
midTextChanged = Replace(midText, vbLf, "")
text = Replace(text, midText, midTextChanged)
InstrStartPosition = startPosition + Len(midTextChanged)
MsgBox "無限ループになっちゃった時はctrl + Breakを押せ" & vbCrLf & vbCrLf & text
Dim textForCheck As String
If textForCheck = text Then
MakeText = text
Exit Function
End If
textForCheck = text
Loop
MakeText = text
End Function
994: 2021/08/28(土)10:10 ID:rHnN1cM5(1) AAS
動けば良いんだよ
995: 2021/08/28(土)12:36 ID:3DqqBWFs(1) AAS
腕が重くて
996: 2021/09/01(水)00:13 ID:7BIbcRgh(1/5) AAS
ｈ
997: 2021/09/01(水)00:13 ID:7BIbcRgh(2/5) AAS
ｔ
998: 2021/09/01(水)00:13 ID:7BIbcRgh(3/5) AAS
ｌ
999: 2021/09/01(水)00:17 ID:7BIbcRgh(4/5) AAS
ｎ
1000: 小倉優子 ◆YUKOH0W58Q 2021/09/01(水)00:17 ID:7BIbcRgh(5/5) AAS
∧,,,∧
( ・∀・) 1000ならジュースでも飲むか
( )
し─J
1001(1): 1001 ID:Thread(1/2) AAS
このスレッドは１０００を超えました。
新しいスレッドを立ててください。
life time: 2294日 13時間 24分 43秒
1002(1): 1002 ID:Thread(2/2) AAS
5ちゃんねるの運営はプレミアム会員の皆さまに支えられています。
運営にご協力お願いいたします。
───────────────────
《プレミアム会員の主な特典》
★ 5ちゃんねる専用ブラウザからの広告除去
★ 5ちゃんねるの過去ログを取得
★ 書き込み規制の緩和
───────────────────
会員登録には個人情報は一切必要ありません。
月300円から匿名でご購入いただけます。
▼ プレミアム会員登録はこちら ▼
外部ﾘﾝｸ:premium.5ch.net
▼ 浪人ログインはこちら ▼
外部ﾘﾝｸ[php]:login.5ch.net
上下前次1-新書関写板覧索設栞歴
ｽﾚ情報 赤ﾚｽ抽出 画像ﾚｽ抽出 歴の未読ｽﾚ
ぬこの手 ぬこTOP 0.014s