文字列から複数の文字列を抽出する方法

質問

画像の様な２パターンの表で
英語の大文字箇所が1つの会社名だとした場合、
会社名のみの効率的な抽出の仕方が知りたいです。

会社名の一覧は別のエクセルシートであります。

もしご存知でしたら、教えて頂けると幸いです。

回答No.3

kkkkkm · ベストアンサー

左の画像だとマクロで(F列に大文字の部分をG列にそれ以降を書き出します)

Sub Test()
Dim RegE As Object, RMatch, PStr As String, i As Long

Range("F:G").ClearContents

Set RegE = CreateObject("VBScript.RegExp")
PStr = "[^A-Z\s]"
With RegE
.Pattern = PStr
.IgnoreCase = False
.Global = True
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
Set RMatch = .Execute(Cells(i, "A"))
If RMatch.Count > 0 Then
Cells(i, "F").Value = Trim(Left(Cells(i, "A").Value, RMatch(0).FirstIndex))
Cells(i, "G").Value = Trim(Mid(Cells(i, "A").Value, RMatch(0).FirstIndex + 1))
End If
Next i
End With
Set RMatch = Nothing
Set RegE = Nothing
End Sub

右の画像だと大文字の部分を

数式だと

=IF(EXACT(A1,PROPER(A1)),"",A1&IF(EXACT(B1,PROPER(B1)),"",B1&IF(EXACT(C1,PROPER(C1)),"",C1)))
C列までしかありませんが必要なだけ追加してください。

マクロだと(K列に書き出します)

Sub Test()
Dim i As Long, j As Long
Dim MStr As String

Range("K:K").ClearContents

For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
MStr = ""
For j = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
If Cells(i, j).Value = StrConv(Cells(i, j).Value, vbLowerCase) Then
Exit For
Else
MStr = MStr & Cells(i, j).Value
End If
Next j
Cells(i, "K").Value = MStr
Next i
End Sub

お礼

お礼が遅くなり申し訳ございません、ご丁寧に回答いただき本当にありがとうございました。

回答No.6

masnoske

> 会社名の一覧は別のエクセルシートであります。

であれば、会社名の一覧シートの会社名よりも前の列にA列と同じデータを入れておいて、A列をキーにして、VLOOKUP関数で会社名の一覧シートから会社名を引っ張れば良いだけでは？

お礼

お礼が遅くなり申し訳ございません、アドバイス参考にさせて頂きました。回答いただき本当にありがとうございました。

回答No.5

imogasi

まあＶＢＡの方でやるのが適当だろう。
VBAは、直ぐマスターできるわけではないが、参考に挙げてみる。
また色々なやり方が考えられることなので、１方法に過ぎない。
質問表現内容やデータ例も、大雑把で納得はできないが、臭いだけ嗅いで、「（会社名）テーブル参照法による割り出し」ならどれぐらいのコード行数になるか感じてみて。
データ例も、実際データを秘密にしたいためだろうが、抽象化しすぎて、良く伝わらない。もう少し工夫して、現実データの臭いを残して質問すべきだろう。
なお、下記は会社名の判別に、語の先頭文字が大文字かどうかは、考えてない。
会社名のテーブルSheet2のA列にその語句があれば、会社名とした。
また早く出てきたもの勝ち。
なお下記では、Sheet1のＰ-X列に半角スペースで区切ったデータを列を分けて出している。Worksheets("Sheet1").Range("P" & i & ":X" & i) = a
とりあえずコメント化（無効）にしたが。
単語数が多い場合は列の範囲を増やす必要がある。プログラムの修正が必要。
ーー
これで実際の現場では、不都合があるかもしれない。
しかしそういう場合は、その点こそ、質問の問題点になることで、それを主たる
論点にして解決法を質問すべきなんだ。
　語句の先頭１文字が大文字であれば、会社名だと断定できるというのは
小生の経験に反するので取り上げていない。
　また今回が初出の会社の場合（Sheet2のA列にその会社名は出てこないが）の問題は、複雑になるので、あえて捨ててある。
ーー
・Sheet1のＢ列に文章（文字列という。やや長文でも可。）があるとする。
・文章の単語（会社名を含む）の前後の区切りは半角のスペース（１文字以上）であるとする
・Sheet2のＡ列に（今までに判っている）会社名がある（入力されている）とする
ーー
テストデータ
Ｓｈｅｅｔ１のＢ列に２例＝２行　がテストデータとする。
ＡＡＡ ＢＢＢ ＣＣＣ 78204 ｄｋｆｖｈｄ
AAA grektl 5930 rkdj
ＳＨｅｅｔ２のＡ列に、会社名があるとする。Ａ１：Ａ５
会社名
dkfvhd
rkdj
krttj
EEE
ーー
標準モジュールに
Sub test01()
Dim a As Variant
For i = 2 To 3
a = Split(Worksheets("Sheet1").Cells(i, "B"), " ")
For j = 0 To UBound(a)
b = StrConv(a(j), vbNarrow)
'MsgBox b
Set s = Worksheets("Sheet2").Range("A2:A10").Find(b) '10は実際の行数で増やすこと
If Not (s Is Nothing) Then
Worksheets("Sheet1").Cells(i, "A") = b
Exit For
End If
Next j
'Worksheets("Sheet1").Range("P" & i & ":X" & i) = a
Next i
End Sub
と入れて実行。
結果
Sheet1のA列に会社名を決めて、出力した。
下記はSheet1のA,B列
dkfvhd ＡＡＡ ＢＢＢ ＣＣＣ 78204 ｄｋｆｖｈｄ
rkdj AAA grektl 5930 rkdj

お礼

お礼が遅くなり申し訳ございません、アドバイス参考にさせて頂きました。ご丁寧に回答いただき本当にありがとうございました。

回答No.4

kkkkkm

No3です。

> 会社名の一覧は別のエクセルシートであります

その一覧を参照して添付画像の各行から会社名を抽出したいということでしたら、その一覧がどのような形式なのか記載したほがいいと思いますよ。回答を自分で修正できるのなら別ですが。

回答No.2

msMike

Sheet2 において、
１．式 =FIND(" ",Sheet1!$A1,A1+1) を入力したセル B1 を下に４行、
￣￣右にズズーッと(列の全セルが #VALUE! を呈するまで)オートフィル
２．I列は「会社名の一覧」リストで、範囲 I2:I5 に名前 list を付けておく

Sheet1 において、
３．次式を入力したセル B1 を下方および右方にオートフィル
￣￣=IF(COUNTIF(list,MID($A1,Sheet2!A1+1,Sheet2!B1-Sheet2!A1-1)),MID($A1,Sheet2!A1+1,Sheet2!B1-Sheet2!A1-1),"")

お礼

お礼が遅くなり申し訳ございません、アドバイス参考にさせて頂きました。ご丁寧に回答いただき本当にありがとうございました。

回答No.1

aokii

マクロ以外の方法では難しいです。
マクロ以外の方法としては、画像の左のパターンの場合、同じシートに会社名の一覧をHH列から右に並べておいて、以下の式をB列に記載して右と下にドラッグコピーしてみてください。
=IF(ISERR(FIND(HH$1,$A1)),"","有")

お礼

お礼が遅くなり申し訳ございません、アドバイス参考にさせて頂きました。ご丁寧に回答いただき本当にありがとうございました。