VBAなんでも質問スレ Part2

VBAなんでも質問スレ ..

■コピペモード
□スレを通常表示
□オプションモード
□このｽﾚｯﾄﾞのURL
■項目テキスト

1011:デフォルトの名無しさん
 21/08/25 17:06:39.36 qYcBJ8fd.net
あんま実験してないから文句いうなよ 
まずはさ、アホでも考えられるような地道な形でやるべきだと思うわ 
そのあとに、効率性とか考えて無駄排除したりすればいいわ 
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

1012:デフォルトの名無しさん
 21/08/25 17:06:59.82 qYcBJ8fd.net
>>991の続き　 
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

次ページ