Excelでの質問です。

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

回答の条件
  • URL必須
  • 1人5回まで
  • 登録:2007/10/03 22:22:22
  • 終了:2007/10/06 02:42:56

回答(4件)

id:airplant No.1

airplant回答回数220ベストアンサー獲得回数492007/10/04 00:28:09

ポイント50pt

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

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

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


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...

id:plugbot

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

2007/10/04 15:53:54
id:Mook No.2

Mook回答回数1312ベストアンサー獲得回数3912007/10/04 01:04:43

ポイント50pt

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/

id:plugbot

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

2007/10/04 16:17:07
id:airplant No.3

airplant回答回数220ベストアンサー獲得回数492007/10/05 01:39:37

ポイント50pt

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

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
id:plugbot

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

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

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

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

さらに質問です。

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

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

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

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

2007/10/05 07:40:31
id:Mook No.4

Mook回答回数1312ベストアンサー獲得回数3912007/10/05 21:17:45

ポイント50pt

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


提示いただいたデータを見た限り、一致しないものも多数残るのだと思いますが、下記のコードでシート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

  • id:Mook
    空欄のものがあるのは、検索方法から同一商品(右4桁の部分)と特定できないためですね。

    桁は実態に応じて増やせばいいですが、右からだけでは検出できないのであれば、検出方法を変えないとなりません。

    ただ、商品名と型番が "-" で区切られているという規則があるのであれば、それを利用できると思うのですが、その点はどうなのでしょうか。
  • id:plugbot
    なるほど、よく分かりました。
    商品名に型番が含まれているというだけで規則性はありません。

    空欄の行を一部調べてみました。
    シートBで右から数えて一意に決まる型番の文字数が9つのものがありました。
    その文字をExcelの標準検索を使ってシートAで検索すると該当するセルが選択されます。つまり共通の商品があるということになります。
    しかしVBAで文字数を9に変えて実行しても結果は空白のままとなります。

    Excelの標準の検索だとばっちりと該当するセルが見つかるのですが、それを使って検出する方法はないのでしょうか。それだと全て解決しそうです。
  • id:Mook
    確認したいのですが、その文字列にマッチするものはシートAとシートBにそれぞれ1つづつでしょうか。

    複数ある場合は一意性が無いとみなされて空白になります。

    シートBで一意性が必要ない場合は、
    ----------------------------------------------------------
      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
    ----------------------------------------------------------
    の部分を
    ----------------------------------------------------------
      dstWS.Cells(i, "A").Value = srcWS.Cells(retA, "A").Value
    ----------------------------------------------------------
    にすれば、どうでしょうか。
  • id:plugbot
    マッチするのは1つずつです。

    商品の数を10くらいに減らして動作を確認すると正常に動きます。
    多くなるとなぜかうまくいかなくなるようです。
  • id:Mook
    やはり正確なデータ定義か、具体的なデータ例がないと、適切な回答は難しいです。

    関係ない部分は適当な文字列に変えられて結構ですので、ある程度のサンプルを提示いただけませんか。

    また、具体的にID が付かないデータを提示いただくと、原因が追求しやすいとか思います。
  • id:airplant
    手順通りにやったら、あっという間にできてしまいました。
    正味10分程度。なお、SheetAもSheetBも誤って全角文字が入っているところがあります。その部分は手修正せずにそのままで行いました(A列が空白で出るので、すぐに分かります)。

    取り出すキー: " ([A-Z0-9/\-\+#]*$)"
    適当なセルに上記の値を入れて、名前付けしておきます。
    今回はkataと名前付けしておきました。
    (セルへの名前付けは、fxと出ている欄の左のアドレス表示欄に文字を入れてできます)
    SheetAとSheetBは同じブック内で作業を行います。
    ●SheetAの状態サンプル

    数式
    =GetRegExpsub(C1,kata,1) No1 apricot AL C2 AL10ACH-3 AL10ACHEZDH3

    AL10ACHEZDH3  No1  apricot AL C2 AL10ACH-3 AL10ACHEZDH3

    (操作)
    A1をコピーして、最終行(A1736)までペーストする。
    $A$2:$C$1736にtblと名前付けする。


    ●SheetBの状態サンプル
    数式
    =GetRegExpsub(C1,kata,1) =VLOOKUP(B1,tbl,2,FALSE) LaVie C LC900/HJ PC-LC900HJ

    PC-LC900HJ  No1245  LaVie C LC900/HJ PC-LC900HJ  →SheetAにあり
      :
    PC-LC950KG  #N/A  LaVie C LC950/KG PC-LC950KG  →SheetAになし

    VLOOKUPでSheetAから探す。→これで#N/Aになったものが、SheetAになくてSheetBにある型番。
    →オートフィルターで、B列が#N/Aなものを持っていけば、SheetAにマスターが統合できる。商品IDの付け方が分からないので、#N/AになったSheetBの行番号を掲載(106件)。
    他の454件は全部番号がついた。

    7,252,369,390,391,392,393,394,395,396,403,412,413,415,417,423,426,427,428,429,430,431,433,434,435,436,437,438,439,441,442,443,444,445,446,448,449,450,451,454,455,462,478,479,480,481,482,484,485,490,491,493,494,495,496,497,498,499,501,502,503,505,506,507,508,509,510,512,513,514,515,517,518,519,520,521,522,523,526,527,528,530,531,533,534,535,536,538,539,541,542,543,545,546,548,549,550,552,553,554,555,556,558,559,560
    →あっ、統合ではなく、SheetBにSheetAと同じ番号を振って終わりでしたね。でも、その後きっと統合するのですよね。

    P.S. 全角は半角に直すとして、型番として意味をなしていないようなのがあるので、横にVOOKUPで製品名を出して本当に一致しているか比較しておくのが無難と思います。
    例えば、440、1501やD620など。

    P.S.2 SheetAがマスタならば、重複が起きているようなのでユニークにしておいたほうがいいでしょう。
    例.D531は、Line No1177,No1178,No1179,No1180,No1183,No1184,No1243,No1244にある。
    今回SheetBでピックアップされた106件には一つも重複ありませんでした。何か質問と違うような感じがします。SheetAとSheetBが逆?
  • id:plugbot
    いろいろ試してみましたが、データ重複の問題もあり最終的にPHPと手動で処理しました。
    PHPの処理ですが、SheetBの商品名一覧、SheetAをCSVで読み込み、正規表現で一致を確かめ、処理の番号と共に該当するIDをログに書き込むという処理の繰り返しでした。

    あとはACCESSでクエリを作って統合したという感じになりました。

    ExcelはPHPで書くときが面倒なときにちょっとだけ利用する程度しか使っていませんでした。VBAはコードが分かれば理解もはやかったでしょうが、今の段階では力不足でした(汗)

    途中で投げてしまいそうでしたが、粘り強くお付き合いいただいたおかげで目的は達しました。お付き合いありがとうございました。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません