プロが教えるわが家の防犯対策術!

A列とD列の名前のアルファベット名の部分が一致すれば、E列の企業番号をB列に表示させたい。
B2には112000と表示されるようにしたい。

アルファベットの部分は実際は長い名称です。
E列は1000件以上あります。

ご教導を宜しくお願い申しあげます。

「文字の一部分一致のデータをVlookup」の質問画像

質問者からの補足コメント

  • もう一度お願い致します。

    ”仮に「株式会社」や「有限会社」という文字以外で検索!というのであれば可能だと思います。”
    と、教えて頂き、除外する語句というのか、個人名のみがあるので、あきらめかけたのですが、
    「株式会社」や「有限会社」がついている企業名だけでも、番号を検索出来れば、後は手作業で調べます。

    またまた、お手数をおかけいたしますが、コードを教えて頂けますでしょうか?
    無理ばかりで申し訳ございません。

    No.2の回答に寄せられた補足コメントです。 補足日時:2016/05/13 16:48

A 回答 (3件)

続けてお邪魔します。



>「株式会社」や「有限会社」がついている企業名だけでも・・・
というコトですので、一案です。
↓の画像のように別Sheet(今回はSheet2)のA列に除外する文字列を羅列しておきます。
その下準備ができた上でのコードになります。

今回は標準モジュールですので、
Alt+F11キー → メニュー → 挿入 → 標準モジュール → VBE画面のカーソルが点滅しているところに
↓のコードをコピー&ペーストし、No.1の方法でマクロを実行してみてください。

Sub Sample2() 'この行から//
Dim i As Long, k As Long
Dim myStr As String, c As Range, wS As Worksheet
Set wS = Worksheets("Sheet2")
Application.ScreenUpdating = False
With Worksheets("Sheet1")
.Range("C:C").Insert
.Range("A:A").Copy .Range("C1")
For k = 2 To wS.Cells(Rows.Count, "A").End(xlUp).Row
.Range("C:C").Replace what:=wS.Cells(k, "A"), replacement:="", lookat:=xlPart
Next k
For i = 2 To .Cells(Rows.Count, "C").End(xlUp).Row
Set c = .Range("E:E").Find(what:=Trim(.Cells(i, "C")), LookIn:=xlValues, lookat:=xlPart)
If Not c Is Nothing Then
.Cells(i, "B") = c.Offset(, 1)
End If
Next i
.Range("C:C").Delete
End With
Application.ScreenUpdating = True
End Sub 'この行まで//

※ Sheet2の除外する文字列はどんどん増やしても構いません。

※ 質問でアップされている配置でのコードです。
1行・1列でもずれた場合は意図しない動きになります。m(_ _)m
「文字の一部分一致のデータをVlookup」の回答画像3
    • good
    • 0
この回答へのお礼

何度もご親切にありがとうございました。
難しいですが、来週、職場でやってみます。
画像もつけて頂き、とても、助かります。
本当にありがとうございました。

お礼日時:2016/05/14 21:42

No.1です。



>仮にA列・D列の企業名をアルファベットにしましたが、
実際は日本語です。

ん~~~かなり厄介ですね。
前回のコードは各セルの文字を1文字ずつ舐めるように検索していき
アルファベットの場合のみ見つけ出し、D列からその文字が含まれるデータを検索しています。

Excel的にはどこからどこまでが企業名なのかを判断できませんので、こちらで指定したやる必要があります。

仮に「株式会社」や「有限会社」という文字以外で検索!というのであれば可能だと思います。
企業名によってもっと除外する語句があるのであれば、除外する「語句」を一覧にし、そのデータを対象に検索する!
という方法になるかと思いますが、
具体的な「語句」がこちらでは判断できないので、コードは記載できません。

※ 当然コードそのものは前回のものと全く異なってきます。m(_ _)m
この回答への補足あり
    • good
    • 0
この回答へのお礼

ご親切にありがとうございました。
やっぱり、やっかいですね。

色々、勉強になりました。
ありがとうございます。

お礼日時:2016/05/13 16:02

こんばんは!



VBAになりますが一例です。
画面左下の操作したいSheet見出し上で右クリック → コードの表示 → VBE画面のカーソルが点滅しているところに
↓のコードをコピー&ペースト → Excel画面に戻り(VBE画面を閉じて)マクロを実行してみてください。
(Alt+F8キー → マクロ → マクロ実行です)

Sub Sample1() 'この行から//
Dim i As Long, k As Long, lastRow As Long
Dim str As String, myStr As String, c As Range
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range(Cells(2, "B"), Cells(lastRow, "B")).ClearContents
For i = 2 To lastRow
For k = 1 To Len(Cells(i, "A"))
str = Mid(Cells(i, "A"), k, 1)
If str Like "[A-Za-z]" Then
myStr = myStr & str
End If
Next k
If Len(myStr) > 0 Then
Set c = Range("D:D").Find(what:=myStr, LookIn:=xlValues, lookat:=xlPart)
If Not c Is Nothing Then
Cells(i, "B") = c.Offset(, 1)
End If
End If
myStr = ""
Next i
End Sub 'この行まで//

※ A列・D列のアルファベットは半角という前提です。
※ 1セル内にアルファベットが飛び飛びに存在する場合は
お望み通りにならないと思います。
※ データ変更があるたびにマクロを実行する必要があります。m(_ _)m
    • good
    • 0
この回答へのお礼

ありがとうございます。
VBAになるのですね。
関数を使って色々、試してみましたが、さっぱりダメでした。
勉強不足で、VBAを理解できるレベルではありません。

仮にA列・D列の企業名をアルファベットにしましたが、
実際は日本語です。
どの部分を変更すれば宜しいでしょうか?
お手数をおかけいたします。
申し訳ございませんが、ご教導をお願い致します。

お礼日時:2016/05/13 10:24

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!