Question

我有一个用户表单，可以将一行信息填入Excel工作表。 excel表有两个电子表格，一个用于数据输入，另一个用于userform中的3个下拉列表。我想删除第二张表并将其放入自己的工作簿中。我的问题是如何编写VBA代码以从droplist工作簿中选择数据（称为“Client and Project Droplists.xlsx”）来填充第一个工作簿中userform中的droplists（称为“Expense Reports Test.xlsm”））？我目前的代码附在下面。

Private Sub cboClient_Change()
Me.cboProject = ""
Select Case Me.cboClient

Case "Wells Fargo"
    Me.cboProject.RowSource = "WellsFargoProjects"
Case "BLUSA"
    Me.cboProject.RowSource = "BLUSAProjects"
Case "JP Morgan"
    Me.cboProject.RowSource = "JPMProjects"
End Select

End Sub

我将在接下来的几个小时内上班，因此可以在问题/评论部分中请求任何其他信息。真的很感谢这项任务的帮助。

Answer 1

我的同事和我分享了很多数据并且在excel中工作了很多，所以我们在网络驱动器上创建了很多共享表，以便在我们的实用程序中使用。

我们采用的一种方法是打开一个全局列表，在本地复制它，然后使用它来填充下拉列表：

Sub GetStatusCodeList()

Dim ThisWb
Set ThisWb = ThisWorkbook

If Dir("\\SERVERNAME\GlobalUtilities\GlobalTables.xlsx") = "" Then Exit Sub
Application.ScreenUpdating = False

Workbooks.Open "\\SERVERNAME\GlobalUtilities\GlobalTables.xlsx", ReadOnly:=True
ActiveWorkbook.Sheets("GlobalTables").UsedRange.Copy ThisWb.Sheets("DropDown").Range("A1")
ActiveWorkbook.Close

Application.ScreenUpdating = True

End Sub

另一种方法只是从全局列表中读取单元格并将它们直接写入条件格式设置列表。此特定代码创建一个可用工作表数组，并使用它来填充下拉列表：

Sub CreateSheetDropdown()

Dim sheetCounter, i
Dim theSheets() As String
ReDim theSheets(ActiveWorkbook.Sheets.Count + 1) As String

For i = 1 To ActiveWorkbook.Sheets.Count
    theSheets(i) = ActiveWorkbook.Sheets(i).Name
Next i

With ThisWb.Sheets(Mtab).Range("SourceTabName")
    .Value = theSheets(1)
    .Validation.Delete
    '.Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
    '    Operator:=xlBetween, Formula1:=Join(theSheets, ",")
    .Validation.Add Type:=xlValidateList, Operator:=xlBetween, Formula1:=Join(theSheets, ",")
    .Validation.ShowError = False
    .Interior.color = RGB(250, 200, 200)
End With

End Sub

最后，此代码从我们保留在共享驱动器上的全局列表中创建用户窗体的下拉列表：

Private Sub UpdateDropdowns()

Dim thisWorkbook
Set thisWorkbook = ActiveWorkbook
If Dir(TABLEPATH) = "" Then
    MsgBox ("GlobalTables File Not Found - Critical Error")
    Me.Hide
    Exit Sub
End If
Workbooks.Open Filename:=TABLEPATH, ReadOnly:=True

'---------------------------------------------
'Method would load from GlobalTables.xlsx
'---------------------------------------------
'Load Utility Names
For Each c In ActiveWorkbook.Sheets(UTIL_SHEET).Range("A2:A" & ActiveWorkbook.Sheets(UTIL_SHEET).Cells(ActiveWorkbook.Sheets(UTIL_SHEET).Rows.Count, "A").End(xlUp).row).Cells
    AddUtilToAll (c.Value)
Next c

End Sub

Private Sub AddUtilToAll(ByVal s)
For Each c In Me.Controls
    If InStr(c.Name, "UtilityCombo") Then c.AddItem (s)
Next c
End Sub

可能最简单的方法是使用第一个 - 只需打开存储在共享驱动器上的工作簿，然后在本地复制每个下拉列表。您可以在Worksheet初始化函数中运行它，以便每次打开文件时更新下拉列表。

希望这会有所帮助，如果您想了解更多信息，请与我们联系。

修改

这里可能更容易阅读。

只需将您的下拉列表链接到指定范围：

'Delete the old named range ThisWorkbook.Names("TestDropdown").Delete 'Define the new named range ThisWorkbook.Names.Add Name:="TestDropdown", RefersTo:=Range("A1:A25")

如何让我的用户表单从单独的工作表中选择下拉列表数据？

1 个答案: