VBA エクセル 文字列

質問

A列に、【鈴木　太郎】、【佐藤　一郎】・・・・と続いていて、B列には鈴木、佐藤・・・と表示させたい場合は以下のソースに、
=LEFT(A1,FIND(" ",SUBSTITUTE(A1,"　"," "))-1)
と同じソースを書けばいいのはわかるのですが、勉強不足でわかりません。教えていただけませんでしょうか。下記のソースも教えていただきました。すごく助かります。

Sub PickupWords()

Dim Matches As Object
Dim Match As Object
Dim buf As String
Dim c As Variant
With CreateObject("VBScript.RegExp")
.Pattern = "【(.+)】"
.Global = False
Application.ScreenUpdating = False
For Each c In Range("A1", Cells(Rows.Count, 1).End(xlUp))
If .Test(c.Value) Then
buf = c.Value
Set Matches = .Execute(buf)
c.Offset(, 1).Value = Matches.Item(0).SubMatches(0) '括弧の中を取り出す
End If
Next c
Application.ScreenUpdating = True
End With
End Sub

回答No.4

WindFaller · ベストアンサー

こんばんは。
#1の回答者です。
>●●dddd【鈴木　太郎】などと前に余計な文字

PickupWords1R()
では、うまくいきませんか？こちらでは出来ますから、

もしかしたら、A1に、横に　●●dddd【鈴木　太郎】●●dddd【佐藤　一郎】などと、つながっているということでしょうか？でしたら、コードを換えなくてはなりません。
もう一度、ご質問内容を、整理していただけませんか？

もちろん、他の方で出来ましたら、こちらに回答する必要はありません。

回答No.3

keithin

アナタのご質問は
＞A列に、【鈴木　太郎】、【佐藤　一郎】・・・・と続いていて
です。

それとは違うデータ、違う事をしたいなら、当たり前ですが違う数式を考えなきゃなりません。それはまた別のお話、別のご質問です。判りますね。
とはいえ。適切な数式をちょっとアタマを使って考えてみれば、マクロは全く同じです。

＞●●dddd【鈴木　太郎】などと前に余計な文字などが入っていた場合

たとえば
sub macro2()
　dim h as range
　with application
　for each h in range("A1:A" & range("A65536").end(xlup).row)
　　h.offset(0, 1) = mid(left(h, .find(" ", .substitute(h,"　"," ") & " ") -1), .find("【", h & "【") +1, 999)
　next
　end with
end sub

回答No.2

keithin

その関数では「【鈴木」と表示されてしまいます。

とはいえ、使い慣れたエクセル関数をマクロでも使えるよう慣れておくと、仕事が早くて便利です。
ご質問の直接の回答として言えば、例えば

sub macro1()
　dim h as range
　with application
　for each h in range("A1:A" & range("A65536").end(xlup).row)
　　h.offset(0, 1) = .substitute(left(h, .find(" ", .substitute(h,"　"," ") & " ") -1), "【","")
　next
　end with
end sub

といった具合で十分です。

補足

ご回答ありがとうございます。感謝しています。

例えば、単純に【鈴木　太郎】ではなく、●●dddd【鈴木　太郎】などと前に余計な文字などが入っていた場合は、どうでしょうか？
試しにやってみたのですが、うまくいきません。

回答No.1

WindFaller

こんにちは。

私のコードをお使いになったのでね。ありがとうございます。
正規表現は、直接VBAの分野とは違いますから、ちょっと取っ付きにくいかもしれませんね。
正規表現は、本格的には、別の勉強が必要かもしれません。

ご質問の関数を、そのまま移植すると、

>=LEFT(A1,FIND(" ",SUBSTITUTE(A1,"　"," "))-1)
　c.Offset(, 1).Value = Mid(buf, 1, InStr(1, buf, Space(1), 1) - 1)

このようなVBA関数を使うことができます。なんとなく見えてくるかと思います。
InStr(1, buf, Space(1), 1)　の最後の、1は、TextCompareモードといって、全角、半角両方を扱うものです。入れる場所は、以下のとおりです。

　For Each c In Range("A1", Cells(Rows.Count, 1).End(xlUp))
　　　If .Test(c.Value) Then
　　　　buf = c.Value
　　　　Set Matches = .Execute(buf)
　　　　buf = Matches.Item(0).SubMatches(0) '括弧の中を取り出す
　　　　c.Offset(, 1).Value = Mid(buf, 1, InStr(1, buf, Space(1), 1) - 1)　'←ココ
　　　End If
　Next c

また、正規表現そのものを活かそうとすると、【([^\s]+).+】　このような検索式（パターン）になります。両方を比較すると、上の数式でやった方に省コードできそうです。掲示板では、全角と半角の空白の区別がつきにくいので、空白文字を文字で表せるようにしていますから、全角半角を直接、検索式に入れれば、そのままパターンだけでも済みます。

'//
Sub PickupWords1R()
　Dim Matches As Object
　Dim Match As Object
　Dim buf As String
　Dim c As Variant
　With CreateObject("VBScript.RegExp")
　　.Pattern = "【([^\s]+).+】"　'スペースまでを出す。
　　.Global = False
　　Application.ScreenUpdating = False
　　For Each c In Range("A1", Cells(Rows.Count, 1).End(xlUp))
　　　If .Test(c.Value) Then
　　　　buf = Replace(c.Value, Space(1), Space(1), , , vbTextCompare)　'全角のスペースを半角にする
　　　　Set Matches = .Execute(buf)
　　　　　　c.Offset(, 1).Value = Matches.Item(0).SubMatches(0) '括弧の中を取り出す
　　　End If
　　Next c
　　Application.ScreenUpdating = True
　End With
End Sub

補足

ご回答ありがとうございます。なんどもありがとうございます。感謝しています。

例えば、単純に【鈴木　太郎】ではなく、●●dddd【鈴木　太郎】などと前に余計な文字などが入っていた場合は、どうでしょうか？
試しにやってみたのですが、うまくいきません。