Question

我对Visual Basic有0次经验，但来自PHP / mysql。

我需要创建一个用户表单，其中可以选择多个产品，并输出生成这些成分的原料列表。

我创建了rawingredients表，产品表和数据透视表。

我已经使用产品名称填充多选列表框，我需要一种方法来为值（行号）分配值，并使用此方法查找所有成分的数据透视表并将其添加到文本中区域。

Private Sub Userform_Initialize()

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

End Sub

我已经尝试使用谷歌搜索方式为值赋值，但我正在努力并想知道我的解决此问题的方法是否不正确，因为我将如何将其作为网站实现。

任何指示都将受到极大的欢迎。

修改

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的表格中，您可以在图片中看到。您可以通过更改工作表名称和范围轻松地将其适合您的工作簿。

Excel用户表单和数据透视表/用户表单中的VBA

1 个答案: