数据验证中的间接函数vba

时间:2016-10-03 05:25:29

标签: excel vba excel-vba validation excel-indirect

我只是一个小问题!

我用excel做了一个带有两个验证列表的宏,第一个列表是有效的,但有了INDIRECT函数,我有cuestion。

第一个列表在Cell b17

我的第二个列表必须使用参考b17来执行间接功能,但是不起作用,我研究的代码是有效的,但是不要在参考B17的下拉列表中只是"复制"这个单元格中的文字。

这是我的代码

 Sub insertfamilyValidate()

' Selecciona la celda basica de indirecto

' insertfamilyValidate Macro
'
' Acceso directo: CTRL+f
'
    Rows("17:18").Select
    Selection.Insert Shift:=xlDown
    Range("A17:M17").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 39423
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A17").Select
    ActiveCell.FormulaR1C1 = "Código"
    Range("B17:D17").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("A17").Select
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("B17:D17").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Familias"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    Range("E17").Select
    ActiveCell.FormulaR1C1 = "Pax Sentadas"
    Range("F17").Select
    ActiveCell.FormulaR1C1 = "Cant."
    Range("G17").Select
    ActiveCell.FormulaR1C1 = "Cost. Unit."
    Range("H17").Select
    ActiveCell.FormulaR1C1 = "Días"
    Range("I17").Select
    ActiveCell.FormulaR1C1 = "Total"
    Range("J17").Select
    ActiveCell.FormulaR1C1 = "%"
    Range("K17").Select
    ActiveCell.FormulaR1C1 = "Descuento"
    Range("L17").Select
    ActiveCell.FormulaR1C1 = "Sub total"
    Range("M17").Select
    ActiveCell.FormulaR1C1 = "Total"
    Range("A17:M17").Select
    Range("M17").Activate
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With

    Dim MiCelda As Range

Set MiCelda = Worksheets("cotizacion").Cells(17, 2)

With Range("A18").Validation
    ' clear previous validation to existing cell
    .Delete

    ' *** Added this debug part ***
    Dim ValidStr            As String
    ValidStr = "=INDIRECT(" & MiCelda.Address(True, True) & ")"
    Debug.Print ValidStr

   .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:="=INDIRECT(" & MiCelda.Address(True, True) & ")"
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
End With
    Range("B18:D18").Select
    Selection.Merge
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,LISTAPRECIOS2016,2,FALSE)"
    Range("E18").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,LISTAPRECIOS2016,3,FALSE)"
    Range("F18").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("G18").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,LISTAPRECIOS2016,9,FALSE)"
    Range("H18").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("I18").Select
    Application.WindowState = xlMinimized
    Application.WindowState = xlNormal
    ActiveCell.FormulaR1C1 = "=RC[-3]*RC[-2]*RC[-1]"
    Range("J18").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("K18").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]*RC[-1]"
    Range("L18").Select
    ActiveCell.FormulaR1C1 = "=RC[-3]-RC[-1]"
    Range("M18").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-1])"
    Range("G18").Select
    Selection.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    Range("I18").Select
    Selection.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    Range("J18").Select
    Selection.Style = "Percent"
    Range("K18").Select
    Selection.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    Range("L18").Select
    Selection.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    Range("M18").Select
    Selection.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    Range("A18").Select
End Sub

我认为问题在于Indirect的结果是" $ B $ 17",所以,如果我在excel中执行Validate列表,结果是= indirect($ B $ 17),那么这是一个字符串引号,这是功能,我尝试删除引号,第一次是好的,但在那之后是一个错误1004。

我知道是最小错误或我的变量是错误的但我无法想象。 有什么帮助吗?

我添加了.delete,错误是一样的。

这是截图

enter image description here

带调试的屏幕截图就在这里......

enter image description here

1 个答案:

答案 0 :(得分:0)

在设置Validation Formula之前,您需要通过添加代码行清除上一个代码:

Range("A18").Validation.Delete

对于完整代码(已测试):

Sub Validate()

Dim MiCelda As Range

Set MiCelda = Worksheets("cotizacion").Cells(17, 2)

With Range("A18").Validation
    ' clear previous validation to existing cell
    .Delete

    ' *** Added this debug part ***
    Dim ValidStr            As String
    ValidStr = "=INDIRECT(" & MiCelda.Address(True, True) & ")"
    Debug.Print ValidStr

   .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:="=INDIRECT(" & MiCelda.Address(True, True) & ")"
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
End With

End Sub

我在即时窗口中得到的结果是:

=INDIRECT($B$17)