如何讓我的用戶表單從單獨的工作表中選擇它的下拉列表數據？

Question

我有一個用戶表單將一行信息填充到Excel工作表中。 Excel工作表有兩個電子表格，一個用於數據輸入，另一個用於用戶表單中的3個列表。我想刪除第二張表並將其製作成自己的工作簿。我的問題在於如何編寫VBA代碼以從下拉列表工作簿中選擇數據（稱爲「客戶端和項目Droplists.xlsx」）以在第一個工作簿中填充用戶窗體中的列表（稱爲「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")