他のテーブルに基づいてセルを塗りつぶす

Question

Excelファイル内の特定の機能を自動化しようとしています。表1は、文字列が含まれている

はコラム "情報" である、2個の空のセルが続く：

は、ここに私の問題です。表1の行のそれぞれについて、表2の列 "Fruit"の値が表1の "Info"列に存在するかどうかをチェックしたい。そうであれば、 "Color"と "Price例えば、第2行には、「色」「黄色」および「価格」「15」が同じであることを意味する「バナナ」という単語が含まれている。表1の行2の列を参照してください。

何とかこの問題は私にとってはとても簡単ですが、これを実装する方法を考え始めると、私は立ち往生します。残念ながら、修正するためのコードはありません。私はこの問題があまりにも曖昧でないことを願っています。

また、MATCHとINDEXを使用して数式を使ってこの問題を解決しようとしましたが、どちらも問題なく動作しました。

Answer 1

最初に一致する単語が見つかったListObject（テーブル）の行を返します。

Public Function MatchFruit(ByVal sInfo As String, ByRef rFruit As Range) As Long 

    Dim vaSplit As Variant 
    Dim i As Long, j As Long 
    Dim rFound As Range 
    Dim sWhat As String 

    vaSplit = Split(sInfo, Space(1)) 

    For i = LBound(vaSplit) To UBound(vaSplit) 
     'strip out non-alpha characters 
     sWhat = vbNullString 
     For j = 1 To Len(vaSplit(i)) 
      If Asc(Mid(LCase(vaSplit(i)), j, 1)) >= 97 And Asc(Mid(LCase(vaSplit(i)), j, 1)) <= 122 Then 
       sWhat = sWhat & Mid(vaSplit(i), j, 1) 
      End If 
     Next j 

     'find the word in the range 
     Set rFound = Nothing 
     Set rFound = rFruit.Find(sWhat, , xlValues, xlWhole, , , False) 
     If Not rFound Is Nothing Then 'if it's found 
      'return the row in the ListObject 
      MatchFruit = rFound.Row - rFruit.ListObject.HeaderRowRange.Row 
      'stop looking 
      Exit For 
     End If 
    Next i 

End Function 

あなたの最初のテーブルがtblDataとあなたの第2のテーブルtblFruitと呼ばれていると仮定すると、あなたは

=INDEX(tblFruit[Color],MatchFruit([@Info],tblFruit[Fruit])) 

を使用して、色と価格になるだろう同様

=INDEX(tblFruit[Price],MatchFruit([@Info],tblFruit[Fruit])) 

ロング説明

vaSplitの代入線は、文字列を区切り文字に基づいて配列に変換するために関数Splitを使用します。あなたのサンプルデータは文章だったので、通常の区切り記号は単語に分割するスペースです。

This is some line about apples. 

のような文字列が配列

vaSplit(1) This 
vaSplit(2) is  
vaSplit(3) some 
vaSplit(4) line 
vaSplit(5) about 
vaSplit(6) apples. 

次へと変換され、Forループは、それが他のリストでそれを見つけることができるかどうかを確認するために、アレイ内のすべての要素を通過します。 LBoundとUbound（下限と上限）の関数が使用されます。なぜなら、配列の要素数がわからないからです。

ループ内の最初の操作は、無関係な文字を取り除くことです。そのために、変数sWhatを作成し、何も設定しません。要素内のすべての文字をループして、a...zの範囲外にあるかどうかを確認します。基本的には、手紙であるものはsWhatに追加され、数字でないもの（数字、スペース、ピリオド）はありません。最後にsWhatは、すべての非アルファ文字を取り除いた現在の要素と同じです。この例では、ピリオドのためにapples.と一致することはないため、削除されています。

良い数字が得られたら、Findメソッドを使用して、その単語がrFruitの範囲に存在するかどうかを確認します。そうであれば、rFoundはNothingにはなりません。

範囲内の単語が見つからない場合、rFoundはNothingになり、関数はゼロを返します。

単語が見つかった場合、関数は、ListObjectが開始する行より少ない行で見つかった行を返します。そうすれば、関数はワークシート上にないListObjectのデータを含む行を返します。これは、式を組み込む場合に有用である。数式が何かを返すようにするには、その数式を数式の名前に割り当てます。

最後に、Exit For行は、一度一致が見つかると、配列を見ているだけで停止します。データに複数の一致がある場合、最初の一致のみが返されます。

のトラブルシューティングあなたが見つける最も可能性の高いエラーは、それが行番号を返すことを期待するときに関数がゼロを返すということです。それはおそらく、リスト内に単語が見つからなかったことを意味します。

両方のリストに一致する単語が含まれていることが確かな場合は、トラブルシューティングの方法を以下に示します。Set rFound =行の後にDebug.Print文を挿入します。 （イミディエイトウィンドウを表示することがVBEでCtrl + G）イミディエイトウィンドウにsWhatを印刷する

 Set rFound = rFruit.Find(sWhat, , xlValues, xlWhole, , , False) 
     Debug.Print "." & sWhat & "." 
     If Not rFound Is Nothing Then 'if it's found 

。単語の周りのピリオドは、印刷可能でない文字（スペースなど）を見ることができるようになっています。 .pears .とpearsを一致させようとすると、最初のスペースに最後にスペースがあるため、一致しません。前後の間隔があるために表示されます。

空白が問題になる場合は、sWhatでTrim$()関数を使用して最初に取り除くことができます。そのDebug.Print Withステートメント

、あなたがタイプミスを持っていることを認識するであろう。その場合には

.paers. 

のような結果が表示される場合があります。

Answer 2

ディックと他の人に興味があるかもしれません。 @ Dick-Kusleikaによって提供された答えに対する私の最後のコメントで述べたように、彼の答えは私の最初の質問を完全にカバーしていませんでした。それは私に大きな洞察力を与え、空のセルに適切なデータを書き込む作業を行ったにもかかわらず、私は実際に何らかの公式をコピー・ペーストしなくても自動的にそれを行うものを探していました。だから私はインターネットから情報を得て、これに興味を持っている同僚とスパーリングして、それを理解しようともっと時間をかけました。そして結局、私はそれを稼働させることができました！ （ハイヤー!!）

以下は私の解決策です。私がまだ初心者であるので、私はおそらく、より良くまたはよりきれいにできるいくつかのことをしました。だから私は本当にこれについてのあなたの意見に興味があり、任意の発言やヒントを聞くのが大好きです。

Sub check_fruit() 

Dim ws As Excel.Worksheet 
Dim lo_Data As Excel.ListObject 
Dim lo_Fruit As Excel.ListObject 
Dim lr_Data As Excel.ListRow 
Dim lr_Fruit As Excel.ListRow 
Dim d_Info As Variant 
Dim f_Fruit As Variant 

Set ws = ThisWorkbook.Worksheets("Exercise") 
Set lo_Data = ws.ListObjects("tblData") 
Set lo_Fruit = ws.ListObjects("tblFruit") 

For Each lr_Data In lo_Data.ListRows 

    'check if field "Color" is empty in tblData' 
    If IsEmpty(Intersect(lr_Data.Range, lo_Data.ListColumns("Color").Range).Value) Then 
     d_Info = Intersect(lr_Data.Range, lo_Data.ListColumns("Info").Range).Value 

     For Each lr_Fruit In lo_Fruit.ListRows 
      f_Fruit = Intersect(lr_Fruit.Range, lo_Fruit.ListColumns("Fruit").Range).Value 

      'check for each row in tblFruit if value for field "Fruit" exists in field "Info" of tblData' 
      If InStr(1, d_Info, f_Fruit, vbTextCompare) <> 0 Then 
       Intersect(lr_Data.Range, lo_Data.ListColumns("Color").Range).Value = Intersect(lr_Fruit.Range, lo_Fruit.ListColumns("Color").Range).Value 
       Intersect(lr_Data.Range, lo_Data.ListColumns("Price").Range).Value = Intersect(lr_Fruit.Range, lo_Fruit.ListColumns("Price").Range).Value 
      End If 

     Next lr_Fruit 

    End If 

Next lr_Data 

End Sub