Excelのユーザーフォームとピボットテーブル/ユーザーフォームのVBA

Question

私はVisual Basicで0回の経験がありますが、PHP/mysqlから来ています。

私は複数の製品を選択することができるユーザーフォームを作成する必要があり、これらの原料を作る原料成分のリストが出力されます。

私はrawingredientsシート、製品シート、ピボットテーブルを作成しました。

私は多品種リストボックスに製品名を入力していますが、値をid（行番号）に割り当て、これを使用してすべての成分のピボットテーブルを検索し、テキスト領域。

Private Sub Userform_Initialize() 

ListBox1.List = sheets(2).Range("B1:B9").Value 

End Sub 

私は値にIDを割り当てる方法をグーグルで試してみましたが、それは私がウェブサイトとしてそれを達成する方法をであるとして、この問題に取り組む私の方法が間違っている場合は苦労と疑問に思って。

これにはどんな方向性も大きく受け取られます。

編集

ingredient_id name 
1 fishmeal 
2 fish oil 
3 soya bean meal 
4 guar meal 
5 soya bean oil 
6 salt 
7 meat and bone meal 
8 green dye 

product_id name 
1 Expander Pellets 
2 Feed Pellets 
3 Green Pellets 

product_id ingredient_id 
1 1 
1 2 
1 3 
1 4 
2 1 
2 5 
2 3 
2 6 
3 7 
3 8 
3 2 

私は3製品名を含むリストボックスを必要とする上記の表のデータを使用しては、これらの製品の任意の数を選択することができます。ボタンの選択が終了すると、ピボットテーブル上の製品にどの成分が含まれているかを調べることによって、成分を含むテキストボックスが生成されます。

これがより明確になることを希望します。

私はピボットテーブルを使用する必要はないかもしれませんが、これは私のバックグラウンドからPHP/mysqlでどのように達成されるかです。

Answer 1

Excelにこのような考えをサポートしていないリレーショナルベースロジックをExcelに配置しようとしています。次の解決策は私が思いつくことができる最高です。

Private Sub Userform_Initialize() 
    ListBox1.List = Sheets("Sheet1").Range("E2:E4").Value 
End Sub 

Private Sub CommandButton1_Click() 
Dim prod_id As Integer 
Dim output As String 
Dim r As Integer 
Dim ingrArr() As Variant 

With Sheets("Sheet1") 
    For i = 0 To ListBox1.ListCount - 1 
     If ListBox1.Selected(i) Then 
      prod_id = Sheets("Sheet1").Range("D" & i + 2).Value 
      j = 2 
      Do While Sheets("Sheet1").Range("G" & j).Value <> "" 
       If Sheets("Sheet1").Range("G" & j).Value = prod_id Then 
        r = Sheets("Sheet1").Columns("A:A").Find(What:=Sheets("Sheet1").Range("H" & j).Value, LookIn:=xlValues, LookAt:=xlWhole, SearchFormat:=False).Row 

        If Not IsInArray(.Range("A" & r).Value, ingrArr) Then 
         output = output & Sheets("Sheet1").Range("B" & r).Value & vbNewLine 
         On Error GoTo ErrHand2: 
          ReDim Preserve ingrArr(1 To UBound(ingrArr) + 1) 
         On Error GoTo 0 
ErrHand2: 
         If Err <> 0 Then 
          Err = 0 
          ReDim Preserve ingrArr(1 To 1) 
         End If 
         ingrArr(UBound(ingrArr)) = .Range("A" & r).Value 
        End If 

       End If 
       j = j + 1 
      Loop 
     End If 
    Next i 
End With 

MsgBox output 

End Sub 

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean 
    On Error GoTo ErrHand1: 
     IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1) 
    On Error GoTo 0 
ErrHand1: 
    If Err <> 0 Then 
     Err = 0 
     IsInArray = False 
    End If 
End Function 

Sheet1という名前の1枚のシートに自分のデータを貼り付けています。シートの名前と範囲を変更することで、ワークブックに簡単に合わせることができます。