人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

Excelでの質問です。
[商品ID][商品名]の列を持つ商品データを2つのシートSheetAとSheetBがあります。
どちらにも商品名の一部に型番が記入されているのですが、商品名の表記が2つのシートで共通ではありません。
SheetBの一意に決まる型番のみデータをRIGHTBなどで抽出してSheetAの商品名フィールドと比較して、
SheetBに共通する商品IDを振ろうと考えています。
この場合はどのように処理したらよいでしょうか。
Excelが難しいならPHPを使った処理でも簡単なソースを書いていただければOKです。

●質問者: plugbot
●カテゴリ:コンピュータ ウェブ制作
✍キーワード:Excel PHP ソース データ フィールド
○ 状態 :終了
└ 回答数 : 4/4件

▽最新の回答へ

1 ● airplant
●50ポイント

最終的におこないたいことが良く分かりませんので、もう少し具体的に書かれると、アドバイスできると思います。

すみません、質問だらけになってしまいます。

(できたら回答受付中のコメントを有効にするといいでしょう)


1.「商品名の一部に型番が記入されているのですが」

一部とは文字中のどの部分ということになりますか? 何かで区切られているという意味でしょうか? それとも本当の「一部」という意味でしょうか? RIGHTBという記載もあるので、右に固定文字で入っているとも推定されます。

ex. はてなグッズA型 HATENA-123(青)

→ HATENA-123を型番とみなすということでしょうか?


2.「SheetBの一意に決まる型番のみデータをRIGHTBなどで抽出」

一意に決まるというのは、SheetBの中でユニークにするということでしょうか? それとも、複数あるものは除外という意味でしょうか?

ex. SheetBの内容

BID1 はてなグッズA型 HATENA-123(青)

BID2 はてなグッズB型 HATENA-124(青)

BID3 はてなグッズB’型 HATENA-124(赤)

BID4 Soft9 ソフトグッズ

→ HATENA-123とSoft9を抽出する?


3.「SheetAの商品名フィールドと比較して、SheetBに共通する商品IDを振ろうと考えています」

ex. SheetAの内容

AID2000 販促 HATENA-123(青)

AID2001 販促 HATENA-124

AID2002 売り物 SOFT9


SheetBは、結局どうなって欲しい? 文意でいくと下記?

AID2000 はてなグッズA型 HATENA-123(青)

BID2 はてなグッズB型 HATENA-124(青)

BID3 はてなグッズB’型 HATENA-124(赤)

AID2002 Soft9 ソフトグッズ


4.元々の商品IDはどこにも出てきませんが、処理には無関係ですね?


うーん、自分でも書いていて訳分からなくなってきました。笑

URLはダミーです。

http://www.google.co.jp/search?sourceid=navclient&aq=t&h...

◎質問者からの返答

SheetA

ID|商品名|

1 |xxxx-aaa|

2 |xx-bbb|

SheetB

ID|商品名|

|yyy-ccc|

|yyyy-aaa|

|xxx-bbb|

このような感じで商品名の型番に含まれる文字から商品の一致を判断し、SheetAのIDを同じと思われるSheetBのIDに記入するというのが目的でした。

ここまでできれば共通IDを基にして商品名の統一ができると思ったからです。

実は質問後に、RIGHTBでは抽出不可能な

xxx-aaa-yyyyのようなタイプの商品名もあることが判明しました。中途半端ですが、質問は一旦終わりたいと思います。


2 ● Mook
●50ポイント

VBA を使用したIDを振る例を作成しみました。


下記の条件を想定して、作成しています。

・SheetA が先頭シート

・SheetB が2番目のシート

また、SheetA, SheetB とも

・A列にID用の列(最初は空欄)

・B列に商品名

・データが1行目から連続して入っている

となっていることを前提としています。


異なる場合は、上記の条件の作業ファイルを作成して実行してみてください。

Option Explicit

Const KEY_LENGTH = 4 '// 比較するキーの長さ

'------------------------------------------------------------
Sub SetID()
'------------------------------------------------------------
' ID採番処理を行う
'------------------------------------------------------------
 Dim wsA As Worksheet
 Dim wsB As Worksheet

 Set wsA = Worksheets(1) '// Sheet A
 Set wsB = Worksheets(2) '// Sheet B

 Dim lastLineA As Long
 lastLineA = wsA.Range("B65535").End(xlUp).Row
 
 Dim lastLineB As Long
 lastLineB = wsB.Range("B65535").End(xlUp).Row
'// Sheet A の A列(ID列)に 1 から連番を振る
 wsA.Range("A1").Value = 1
 wsA.Range("A2").Value = 2

 wsA.Range("A1:A2").AutoFill _
 Destination:=wsA.Range("A1:A" & lastLineA), Type:=xlFillDefault
 
'// Sheet B の IDを振る処理
 Call searchAndSetID(wsA, lastLineA, wsB, lastLineB)
End Sub

'------------------------------------------------------------
Sub searchAndSetID(srcWS As Worksheet, srcLastLine As Long, dstWS As Worksheet, dstLastLine As Long)
'------------------------------------------------------------
' ID 列を検索して、該当するものを設定
'------------------------------------------------------------
 Dim srcRange As Range
 Set srcRange = srcWS.Range("B2").Resize(srcLastLine, 1)
 Dim dstRange As Range
 Set dstRange = dstWS.Range("B2").Resize(dstLastLine, 1)
 
 Dim i As Long
 Dim retA As Long
 Dim retB As Long
 For i = 1 To dstLastLine
 retA = getProductRow(srcRange, Right(dstWS.Cells(i, "B").Value, KEY_LENGTH))
 If retA > 0 Then
 retB = getProductRow(dstRange, Right(dstWS.Cells(i, "B").Value, KEY_LENGTH))
 If retB > 0 Then
 dstWS.Cells(i, "A").Value = srcWS.Cells(retA, "A").Value
 End If
 End If
 Next
End Sub
'------------------------------------------------------------
Function getProductRow(srcRange As Range, sKey As String) As Long
'------------------------------------------------------------
' 検索対象に、一致するものが1つだけある場合は列を返す
' 一致しなかったり、一致するものが2つ以上ある場合は-1を返す
'------------------------------------------------------------
 Dim aRng As Range
 getProductRow = -1

 For Each aRng In srcRange
 If InStr(aRng.Value, sKey) = (Len(aRng.Value) - Len(sKey) + 1) Then
 If getProductRow = -1 Then
 getProductRow = aRng.Row
 Else
 getProductRow = -1
 Exit Function
 End If
 End If
 Next
End Function

不明な点はコメントで対応しますので、何かある場合はコメントを有効にお願いします。

http://www.asahi-net.or.jp/~ef2o-inue/

◎質問者からの返答

SheetAには連番が振られました。BにはAに共通する番号が振られるものもあれば、空欄のままというものもあります。得られる結果としては不十分でした。


3 ● airplant
●50ポイント

行いたいことは大体わかりました。

SheetAにマスタがあり、SheetBには「ゆれ」のあるリストがあるのですね。

SheetB側にSheetAのIDを振りたいということで良いでしょうか?

「一意」というのは、「SheetBの商品名欄にある文字が、SheetA側のマスタと一部分でも一致したら」と読み替えればいいと解釈しました。


●重要な点

文字数は一定ですか?(雰囲気的には可変のような気がします)

規則はどうなっていますか?(英字で始まって半角英数とか。)


規則が明確なのであれば、正規表現で取り出ししてしまえば、後はなんとでもなります。

例えば、半角の英字で始まって、後は英数が続く可変長の文字の部分を型番とみなす場合は、下記のような正規表現で取り出しできます。

([A-Z]+[A-Z0-9]*)

右はじだけでなく真ん中でも左でもどこにあっても構いません。

●手順

Step1.添付のマクロを入れる

Step2.SheetA、SheetBの両方ともに先頭列に次のファンクションを入れる

SheetA

A B C
=GetRegExpsub(C1,"([A-Z]+[A-Z0-9]*)",1) AID2002 売り物 SOFT9

SheetB

A B C
=GetRegExpsub(C1,"([A-Z]+[A-Z0-9]*)",1) Soft9 ソフトグッズ

そうすると、次のようにC列に型番の一覧が出ますので、後はVLOOKUPやピボットで自由に一覧やID付けができます。VLOOKUPは特に解説不要と思いますので、省略します。

SheetA

A B C
SOFT9 AID2002 売り物 SOFT9

SheetB

A B C
Soft9 Soft9 ソフトグッズ

なお、Microsoft系正規表現の詳細は、こちらを参照ください。

もっと分かりやすいページもあると思いますので、方言がない部分については、google:正規表現でお好みのところを見られてみるといいと思います。


'正規表現を元にサブマッチ文字列を取り出す
'
'表記方法 GetRegExpSub(ソース文字列, 検索正規表現, 取り出すマッチ文字列の場所)
' 出力:マッチ文字列
'Excel内からの呼び出し:
' = GetRegExpSub(Src, Exp, Seq)
' Src:ソースの列に名前を付けるか、A:Aのように指定
' Exp:「[^A-Z]*([A-Z]+[A-Z0-9]*)[^A-Z]*」のように検索パターンを指定する
' Expが複数場所にマッチなら、先頭のマッチのみが対象
' Seq:取り出すサブマッチ文字列の場所を指定する。0なら全マッチ取り出し
' ex. Src=あいAB123うえC456お、Exp=上記
' Seq=0 → あいAB123うえC456お
'   Seq=1 → AB123, Seq=2 → C456
' ex. Src=あいAB123うえB456お、Exp=([A-Z]+[A-Z0-9]*)
' Seq=0 → AB123
'   Seq=1 → AB123, Seq=2 → C456、Seq=3→#VALUE

Function GetRegExpSub(strSrc As String, RGEPattern As String, Seq As Integer) As String
 
 Dim oRge, oMatchs, oMatche As Variant
 
 Set oRge = CreateObject("VBScript.RegExp")
 With oRge
 .IgnoreCase = True '大小文字無視
 .Global = True '文字列全体が対象
 .Pattern = RGEPattern '検索パターン
 
 'Matchesコレクションを取得
 Set oMatchs = oRge.Execute(strSrc)
 'マッチしていなかったら終了
 If oMatchs.Count = 0 Then
 GetRegExpSub = ""
 Else
 '最初のMatchesコレクションを設定
 Set oMatche = oMatchs(0)
 '全体取り出しなら全マッチ部分を入れる
 If Seq = 0 Then
 GetRegExpSub = oMatche.Value
 Else
 'サブマッチ取り出しなら指定場所の文字を入れる
 GetRegExpSub = oMatche.SubMatches(Seq - 1)
 End If
 End If
 End With
 Set oMatche = Nothing
 Set oMatchs = Nothing
 Set oRge = Nothing

End Function
◎質問者からの返答

SheetAはA列にID、B列に商品名

SheetBはA列がIDを振りたい列、B列は商品名

そしてどちらのシートの商品名も共通部分はあるが文字数が違うし、共通部分の出現パターンも一定ではないというのが今回の前提です。

自分が使えるかどうかは別として、正規表現を使ってという意味は理解しています。

さらに質問です。

>SheetA、SheetBの両方ともに先頭列に次のファンクションを入れる

これは1行挿入してA1,B1,C1にそれぞれ入力するということでいいんでしょうか?

あと基本的なことなのですがマクロはVisual Basic Editorを開いてどこに貼ればいいのでしょうか。ThisWorkbookに貼ればよいのでしょうか。

今の状態はA1に#NAME?が出現して終わったままです。


4 ● Mook
●50ポイント

製品番号は、スペースで区切られていると想定し、スペースで単語に分割して検索をして見ました。


提示いただいたデータを見た限り、一致しないものも多数残るのだと思いますが、下記のコードでシートBのデータのうち 1/3 程度にIDが付きました。


仕様に勘違いがあったらコメントください。

Option Explicit

Const KEY_MIN_LENGTH = 5 '// 比較するキーの長さ

'------------------------------------------------------------
Sub SetID()
'------------------------------------------------------------
' ID採番処理を行う
'------------------------------------------------------------
 Dim wsA As Worksheet
 Dim wsB As Worksheet

 Set wsA = Worksheets(1) '// Sheet A
 Set wsB = Worksheets(2) '// Sheet B

 Dim lastLineA As Long
 lastLineA = wsA.Range("B65535").End(xlUp).Row
 
 Dim lastLineB As Long
 lastLineB = wsB.Range("B65535").End(xlUp).Row
'// Sheet A の A列(ID列)に 1 から連番を振る
 wsA.Range("A1").Value = 1
 wsA.Range("A2").Value = 2

 wsA.Range("A1:A2").AutoFill _
 Destination:=wsA.Range("A1:A" & lastLineA), Type:=xlFillDefault
 
'// Sheet B の IDを振る処理
 Call searchAndSetID(wsA, lastLineA, wsB, lastLineB)
End Sub

'------------------------------------------------------------
Sub searchAndSetID(srcWS As Worksheet, srcLastLine As Long, dstWS As Worksheet, dstLastLine As Long)
'------------------------------------------------------------
' ID 列を検索して、該当するものを設定
'------------------------------------------------------------
 Dim srcRange As Range
 Set srcRange = srcWS.Range("B1").Resize(srcLastLine, 1)
 Dim dstRange As Range
 Set dstRange = dstWS.Range("B1").Resize(dstLastLine, 1)
 
 Dim i As Long
 Dim ret As Long
 Dim keyWords As Variant
 Dim keyIndex As Integer
 Dim keyCount As Integer
 For i = 1 To dstLastLine
 keyCount = 0
'// シートAのデータをスペースで分割し単語を後ろからチェックし、
'// ・5文字以上
'// ・シートA内でユニーク
'// ・後ろから二つまで
'// を製品番号としてシートBで検索
 
 keyWords = Split(srcWS.Cells(i, "B").Value, " ")
 For keyIndex = UBound(keyWords) To LBound(keyWords) Step -1
 If Len(keyWords(keyIndex)) > KEY_MIN_LENGTH Then
 If getProductRow(srcRange, CStr(keyWords(keyIndex))) = i Then
 checkKeyWord dstRange, CStr(keyWords(keyIndex)), srcWS.Cells(i, "A")
 keyCount = keyCount + 1
 If keyCount = 2 Then
 Exit For
 End If
 End If
 End If
 Next
 Next
End Sub
'------------------------------------------------------------
Sub checkKeyWord(srcRange As Range, sKey As String, id As Long)
'------------------------------------------------------------
' シートB で一致するデータにIDを付与
'------------------------------------------------------------
 Dim aRng As Range

 For Each aRng In srcRange
'// あいまいにコードが一致もOKとする場合 : PC-LL550KG も認識する場合
'// If InStr(aRng.Value, sKey ) > 0 Then
'// 厳密にコードが一致する場合 : とりあえずこっちを有効
 If InStr(aRng.Value & " ", " " & sKey & " ") > 0 Then
 If aRng.Offset(0, -1).Value = "" Then
 aRng.Offset(0, -1).Value = id
 Else
 aRng.Offset(0, -1).Value = aRng.Offset(0, -1).Value & "," & id
 End If
 End If
 Next
End Sub

'------------------------------------------------------------
Function getProductRow(srcRange As Range, sKey As String) As Long
'------------------------------------------------------------
' 検索対象に、一致するものが1つだけある場合は列を返す
' 一致しなかったり、一致するものが2つ以上ある場合は-1を返す
'------------------------------------------------------------
 Dim aRng As Range
 getProductRow = -1

 For Each aRng In srcRange
 If InStr(aRng.Value, sKey) = (Len(aRng.Value) - Len(sKey) + 1) Then
 If getProductRow = -1 Then
 getProductRow = aRng.Row
 Else
 getProductRow = -1
 Exit Function
 End If
 End If
 Next
End Function

今回は使用していませんが、VBA ないで検索を行う場合の凡例です。

http://www.k1simplify.com/vba/tipsleaf/leaf51.html

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ