用Vba代码写一个程序模块，运行后实现根据sheet1工作表a列内容在b列出线下拉多选框。果a列内容为水果，那b列出现香蕉、苹果、雪梨、火龙果下拉多选框；如果a列内容为蔬菜，则b列出现白菜、菠菜、西兰花、包菜下拉多选框，若选择两个以上，用分号隔开。

以下是用VBA代码实现根据Sheet1工作表A列内容在B列出现下拉多选框的程序模块：

Sub CreateDropDown()
Dim lastRow As Long
Dim fruitList As Variant
Dim veggieList As Variant
Dim i As Long
Dim cell As Range

fruitList = Array("香蕉", "苹果", "雪梨", "火龙果")
veggieList = Array("白菜", "菠菜", "西兰花", "包菜")

lastRow = Cells(Rows.Count, "A").End(xlUp).Row

For i = 2 To lastRow
Set cell = Range("B" & i)
If Range("A" & i).Value = "水果" Then
With cell.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:=Join(fruitList, ";")
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
ElseIf Range("A" & i).Value = "蔬菜" Then
With cell.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:=Join(veggieList, ";")
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End If
Next i
End Sub

希望这个程序模块能够帮助你解决问题！