Excel - 从属数据验证ComboBox不适用于OFFSET功能

时间:2018-06-09 08:19:09

标签: excel vba combobox

我在使用BeforeDoubleClick的Excel工作表上有代码。此代码将组合框放在双击的任何包含数据验证公式的单元格上。组合框采用了公式。

我喜欢这样,因为您获得了数据验证列表,但您也可以选择让用户输入组合框并获取数据验证选项的自动完成功能。

工作表有两个数据验证区域,一个用于State,一个用于District。区数据验证取决于State的选择,我使用了OFFSET函数。

但是我用于组合框的代码仅适用于INDIRECT函数而不适用于OFFSET。

感谢任何帮助!

工作表代码:(http://www.contextures.com/xlDataVal11.html#depend)显示如何为= INDIRECT执行此操作,但对于= OFFSET(我用于依赖数据验证)它不起作用。))

 '==========================
Private Sub Worksheet_BeforeDoubleClick _
  (ByVal Target As Range, _
    Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet

Set cboTemp = ws.OLEObjects("TempCombo")
  On Error Resume Next
  With cboTemp
  'clear and hide the combo box
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
  End With
On Error GoTo errHandler
  If Target.Validation.Type = 3 Then
    **'if the cell contains 
      'a data validation list**
    Cancel = True
    Application.EnableEvents = False
    'get the data validation formula
    str = Target.Validation.Formula1
    str = Right(str, Len(str) - 1)
   **'for simple INDIRECT function (English)
   ' e.g. =INDIRECT(B2)
   'will create dependent list of items**
   If Left(str, 4) = "INDI" Then
     lSplit = InStr(1, str, "(")
     str = Right(str, Len(str) - lSplit)
     str = Left(str, Len(str) - 1)
     str = Range(str).Value
   End If
    With cboTemp
      'show the combobox with the list
      .Visible = True
      .Left = Target.Left
      .Top = Target.Top
      .Width = Target.Width + 5
      .Height = Target.Height + 5
      .ListFillRange = str
      .LinkedCell = Target.Address
    End With
    cboTemp.Activate
    'open the drop down list automatically
    Me.TempCombo.DropDown 
  End If

errHandler:
  Application.EnableEvents = True
  Exit Sub

End Sub
'=========================================
Private Sub TempCombo_LostFocus()
  With Me.TempCombo
    .Top = 10
    .Left = 10
    .Width = 0
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
    .Value = ""
  End With
End Sub
 '====================================
'Optional code to move to next cell 
'if Tab or Enter are pressed
'from code by Ted Lanham
'***NOTE: if KeyDown causes problems, 
'change to KeyUp
'Table with numbers for other keys 
'such as Right Arrow (39)
'https://msdn.microsoft.com/en-us/
  library/aa243025%28v=vs.60%29.aspx

Private Sub TempCombo_KeyDown(ByVal _
     KeyCode As MSForms.ReturnInteger, _
     ByVal Shift As Integer)
  Select Case KeyCode
    Case 9 'Tab
      ActiveCell.Offset(0, 1).Activate
    Case 13 'Enter
      ActiveCell.Offset(1, 0).Activate
    Case Else
        'do nothing
  End Select
End Sub
'====================================

0 个答案:

没有答案