[過去ﾛｸﾞ] VBAなんでも質問スレ Part2 [転載禁止]©2ch.net (993ﾚｽ)
上下前次1-新
抽出解除 必死ﾁｪｯｶｰ(本家) (べ) 自ID ﾚｽ栞 あぼーん

---

このｽﾚｯﾄﾞは過去ﾛｸﾞ倉庫に格納されています｡
次ｽﾚ検索 歴削→次ｽﾚ 栞削→次ｽﾚ 過去ﾛｸﾞﾒﾆｭｰ

---

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

---

上下前次1-新書関写板覧索設栞歴

---

ｽﾚ情報 赤ﾚｽ抽出 画像ﾚｽ抽出 歴の未読ｽﾚ

---

ぬこの手 ぬこTOP 0.034s