Excel用户窗体和透视表/用户窗体中的VBA

我对VisualBasic没有经验，但来自PHP/mysql

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

我已经创建了一个原料表、产品表和数据透视表

我已经用产品名称填充了一个多选列表框，我需要一种方法来分配idrow编号的值，并使用它来查找所有成分的透视表，并将其添加到文本区域

Private Sub Userform_Initialize()

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

End Sub

我曾尝试用谷歌搜索一种为值分配id的方法，但我很挣扎，想知道我解决这个问题的方法是否不正确，因为这是我作为一个网站应该如何实现的

任何有关这方面的指示都将受到极大的欢迎

编辑

使用上表数据，我需要一个包含3个产品名称的列表框，可以选择任意数量的产品。完成选择按钮后，将通过在透视表上查找属于产品的成分，生成包含成分的文本框

我希望这更清楚

---

我可能不需要使用透视表，但从我的背景来看，这就是在PHP/mysql中实现透视表的方法。

您试图将关系型基本逻辑放入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的表格中，表格如图所示。通过更改工作表名称和范围，您可以轻松地将其放入工作簿

---

请再次解释一下，也许是重点，你想达到什么目标。你把4个独立的东西放在一句话里，这让它们的每一个细节都有点神秘。添加了一个编辑，希望能把它弄清楚？你将这些表格存储在某个excel表格中，对吗？目前每个表格都在一个单独的表格上这太棒了，非常感谢。我怀疑我可能一直在试图以错误的方式进行此事。我不理解代码的每一部分，但我可以修改它，我已经将它输出到一个文本框中，输出中的每个值都是逗号分隔的。有没有一种简单的方法可以从输出中删除重复的原始成分？我看到的最干净的解决方案是用使用的成分id创建数组，并且每次都检查当前成分id是否在这个列表中。Limak我正在努力使用语法在列表中创建数组visual basic。。。。他们似乎想要声明数组的长度，或者每次都必须使用redim，这在循环中显然是个坏主意？请参阅我的编辑。我知道这很让人困惑，但为了解决空数组上执行函数的问题，我不得不这样做。VBA中的抽象数据类型的实现非常差。

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