2016-10-03 185 views
0

我只是一个小问题!数据验证的间接函数vba

我做了一个宏与两个验证列表的Excel,第一个列表功能,但与INDIRECT函数我有cuestion。

第一清单中的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 

我认为问题是,结果间接为“$ B $ 17”,因此,是一个字符串,如果我这样做在Excel中验证列表中的结果是= INDIRECT ($ B $ 17)没有引号,这是funcional,我尝试删除引号,第一次是好的,但在此之后是一个错误1004.

我知道是一个最小错误或我的变量是错误的,但我不能确定它。 有什么帮助吗?

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

这是截图

enter image description here

与调试的截图在这里...

enter image description here

回答

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) 
+0

感谢您的帮助,但即使是.delete代码是相同的错误代码1004 ... –

+0

@LadyMuerte,但你没有复制'.Add类型:= xlValidateList'的下一行...没有“”“ –

+0

我这样做,但如果我删除引号,该函数说错误1004,用三个引号的功能是完整的,但与单元格b17的内容在a18 –