簡體   English   中英

Excel用戶窗體和數據透視表/用戶窗體中的VBA

[英]VBA in Excel userform and pivot tables/userforms

我有0個Visual Basic經驗,但來自PHP / mysql。

我需要創建一個用戶表單,在該表單中可以選擇多種產品,並輸出構成這些成分的原始成分列表。

我已經創建了rawingredients表,products表和數據透視表。

我已經用產品名稱填充了一個多選列表框,我需要一種為值分配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中實現它。

您正在嘗試將關系基礎邏輯放入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

我將數據放在一張名為Sheet1Sheet1 ,其形式可以在圖片中看到。 您可以通過更改工作表名稱和范圍輕松將其適合您的工作簿。

圖片1

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM