comboboxVBA Excel使用其他工作表中的数据库
我希望你们能够帮助我尝试为这种任务获得一些VBA代码。 让我们说我在表1中有这个：
并在Sheet 2中有数据库（文件可以在这里下载）：
如果单击工作表1中的combobox，工作表2中的列表COMPANY将出现。 如果我select，例如美国，则CITY和ASSET VALUE栏中的单元格将相应地自动更改（在这种情况下，Boston和89,826,717.71）。 当我select在CITY中有多个选项的COMPANY时，任务变得更加困难，例如XYZ在CITY中有三个选项：Seattle，Indiana和Los Angeles。 我已经阅读了无数的文章和互联网上的post，但似乎没有任何工作。 我正在使用Excel 2010，如果有人可以提供任何帮助，我将非常感激。
示例文件下载链接示例文件
代码：
Private Sub Worksheet_Change(ByVal Target As Range) Dim ctgCount, UniqueCount As Long Dim subCategory() As String Dim subItems As String Dim myItems, ValidationFormula As String Dim ArrayItemCount As Long Dim UniqueItemMatch As Boolean myItems = "" If Not Application.Intersect(Target, Range("C3:C12")) Is Nothing Then If Target.Value = "" Then Target.Offset(0, 1).Clear Exit Sub End If ctgCount = Application.WorksheetFunction.CountIf(Sheet2.Range("C3:C22"), Target.Value) - 1 ReDim subCategory(ctgCount) For Each cel In Sheets("Sheet2").Range("C3:C22") UniqueItemMatch = False If cel.Value = Target.Value Then For i = 0 To ctgCount If cel.Offset(0, 1).Value = subCategory(i) Then UniqueItemMatch = True Exit For Else UniqueItemMatch = False End If Next i If UniqueItemMatch = False Then UniqueCount = 0 For j = 0 To UBound(subCategory()) If subCategory(j) <> "" Then UniqueCount = UniqueCount + 1 Next j subCategory(UniqueCount) = cel.Offset(0, 1).Value End If End If Next cel For k = 0 To UBound(subCategory()) If subCategory(k) <> "" Then myItems = myItems & ", " & subCategory(k) ValidationFormula = Mid(Trim(myItems), 2, Len(Trim(myItems)) - 1) Next k Target.Offset(0, 1).Select Selection.Clear With Selection.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:=ValidationFormula .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With End If '************** For 2nd sub Items *************************************************************** If Not Application.Intersect(Target, Range("D3:D12")) Is Nothing Then If Target.Value = "" Then Target.Offset(0, 1).Clear Exit Sub End If ctgCount = Application.WorksheetFunction.CountIf(Sheet2.Range("D3:D22"), Target.Value) - 1 ReDim subCategory(ctgCount) For Each cel In Sheets("Sheet2").Range("D3:D22") UniqueItemMatch = False If cel.Value = Target.Value Then For i = 0 To ctgCount If cel.Offset(0, 1).Value = subCategory(i) Then UniqueItemMatch = True Exit For Else UniqueItemMatch = False End If Next i If UniqueItemMatch = False Then UniqueCount = 0 For j = 0 To UBound(subCategory()) If subCategory(j) <> "" Then UniqueCount = UniqueCount + 1 Next j subCategory(UniqueCount) = cel.Offset(0, 1).Value End If End If Next cel For k = 0 To UBound(subCategory()) If subCategory(k) <> "" Then myItems = myItems & ", " & subCategory(k) ValidationFormula = Mid(Trim(myItems), 2, Len(Trim(myItems)) - 1) Next k Target.Offset(0, 1).Select Selection.Clear With Selection.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:=ValidationFormula .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With End If End Sub